Fixed line overflow to ACCEPT.
This commit is contained in:
@ -84,3 +84,17 @@ e: test-recurse
|
||||
: factorial dup 0= if drop 1 else dup 1- recurse * then ;
|
||||
5 factorial 120 = assert
|
||||
;e
|
||||
|
||||
e: test-accept
|
||||
in: 1234567890xxxxxx
|
||||
pad 10 accept
|
||||
pad swap type cr
|
||||
out: --> 1234567890
|
||||
out: 1234567890
|
||||
;e
|
||||
|
||||
e: test-key
|
||||
in: 1
|
||||
key 49 = assert
|
||||
key nl = assert
|
||||
;e
|
||||
|
||||
@ -217,7 +217,10 @@ variable echo -1 echo ! variable arrow -1 arrow !
|
||||
dup ?echo
|
||||
>r rot r> over c! 1+ -rot swap 1+ swap
|
||||
then
|
||||
repeat drop nip ;
|
||||
repeat drop nip
|
||||
( Eat rest of the line if buffer too small )
|
||||
begin key dup nl = over 13 = or if ?echo exit else drop then again
|
||||
;
|
||||
200 constant input-limit
|
||||
: tib ( -- a ) 'tib @ ;
|
||||
create input-buffer input-limit allot
|
||||
|
||||
@ -30,6 +30,17 @@ variable confirm-old-type
|
||||
: expect-finish expected resulted str= if exit then }confirm
|
||||
cr ." Expected:" cr expected type cr ." Resulted:" cr resulted type cr 1 throw ;
|
||||
|
||||
( Input testing )
|
||||
create in-buffer 1000 allot
|
||||
variable in-head variable in-tail
|
||||
: >in ( c -- ) in-buffer in-head @ + c! 1 in-head +! ;
|
||||
: in> ( -- c ) in-tail @ in-head @ < assert
|
||||
in-buffer in-tail @ + c@ 1 in-tail +!
|
||||
in-head @ in-tail @ = if 0 in-head ! 0 in-tail ! then ;
|
||||
: s>in ( a n -- ) for aft dup c@ >in 1+ then next drop ;
|
||||
: in: ( "line" -- ) nl parse s>in nl >in ;
|
||||
' in> is key
|
||||
|
||||
( Testing Framework )
|
||||
( run-tests runs all words starting with "test-", use assert to assert things. )
|
||||
variable tests-found variable tests-run variable tests-passed
|
||||
|
||||
Reference in New Issue
Block a user