--- gforth/test/other.fs 1997/05/21 20:40:20 1.1 +++ gforth/test/other.fs 2000/02/04 14:52:30 1.14 @@ -1,6 +1,6 @@ \ various tests, especially for bugs that have been fixed -\ Copyright (C) 1997 Free Software Foundation, Inc. +\ Copyright (C) 1997,1998 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -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,73 @@ 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 + +\ filenames with "//" + +s" //jkfklfggfld/fjsjfk/hjfdjs" open-fpath-file 2drop + +\ allotting negative space + +1 allot +-1 allot + +\ unaligned input for head? + +here 1+ head? throw + +\ [compile] exit = exit + +: foo [compile] exit abort" '[compile] exit' broken" ; +foo \ comments across several lines @@ -68,7 +153,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