--- gforth/test/other.fs 1997/07/31 16:17:28 1.4 +++ gforth/test/other.fs 1999/02/22 21:39:45 1.11 @@ -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 ) @@ -74,13 +92,54 @@ s" a " 2 /string -trailing throw dro 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 + \ 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