--- gforth/test/other.fs 1997/05/21 20:40:20 1.1 +++ gforth/test/other.fs 1998/04/14 16:43:22 1.7 @@ -52,6 +52,24 @@ foo1 5 fac 120 <> throw +\ TO and locals + +: locals-test2 ( -- ) + true dup dup dup { addr1 u1 addr2 u2 -- n } + false TO addr1 + addr1 false <> abort" TO does not work on locals" ; +locals-test2 + +: locals-test3 ( -- ) + \ this should compile, but gives "invalid name argument" on gforth-0.3.0 + 0 { a b } 0 to a ; + +\ multiple reveals (recursive) + +0 +: xxx recursive ; +throw \ if the TOS is not 0, throw an error + \ look for primitives ' + look 0= throw ( nt ) @@ -61,6 +79,55 @@ s" +" find-name <> throw 1e pad 5 represent -1 <> swap 0 <> or swap 1 <> or throw +\ -trailing + +s" a " 2 /string -trailing throw drop + +\ convert (has to skip first char) + +0. s" 123 " drop convert drop 23. d<> throw + +\ search + +name abc 2dup name xyza search throw d<> throw +name b 2dup name abc search throw d<> throw + +\ only + +: test-only ( -- ) + get-order get-current + 0 set-current + only + get-current >r + set-current set-order + r> abort" ONLY sets current" ; +test-only + +\ create-interpret/compile + +: my-constant ( n "name" -- ) + create-interpret/compile + , +interpretation> + @ + + @ postpone literal + throw +: five' five ; +five' 5 <> throw + +\ structs and alignment + +struct + char% field field1 + float% field field2 +end-struct my-struct% + +0 field2 float% %alignment <> throw \ comments across several lines @@ -68,7 +135,7 @@ s" +" find-name <> throw abort" ( does not work across lines" ) -s" ( testing ( without delimited by newline in non-files" evaluate +s" ( testing ( without being delimited by newline in non-files" evaluate \ last test! \ testing '(' without ')' at end-of-file