--- gforth/test/other.fs 1997/10/24 17:13:31 1.5 +++ gforth/test/other.fs 2000/09/23 15:06:11 1.17 @@ -1,6 +1,6 @@ \ various tests, especially for bugs that have been fixed -\ Copyright (C) 1997 Free Software Foundation, Inc. +\ Copyright (C) 1997,1998,2000 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -60,6 +60,10 @@ foo1 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 @@ -99,13 +103,84 @@ name b 2dup name abc search throw d<> th 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 + +\ restore-input + +: test-restore-input[ ( -- ) + refill 0= abort" refill failed" + bl word drop + save-input + refill 0= abort" refill failed" + -1 ; + +: ]test-restore-input ( -- ) + drop restore-input abort" restore-input failed" 0 ; + +\ First input is skipped until the "]test-restore-input", then it is +\ reset to just before "0 [if]" +test-restore-input[ abort \ these aborts are skipped +abort 0 [if] + s" oops" 2drop ]test-restore-input abort +[then] +( 0 ) throw + +\ the same test with CRLF newlines +test-restore-input[ abort \ these aborts are skipped +abort 0 [if] + s" oops" 2drop ]test-restore-input abort +[then] +( 0 ) 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