--- gforth/test/other.fs 1997/06/06 17:28:17 1.2 +++ gforth/test/other.fs 1998/12/08 22:03:16 1.9 @@ -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 ; .s +throw \ if the TOS is not 0, throw an error + \ look for primitives ' + look 0= throw ( nt ) @@ -65,13 +83,59 @@ s" +" find-name <> throw 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 ( fjklfjlas;d 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