version 1.6, 1997/10/27 18:25:23
|
version 1.17, 2000/09/23 15:06:11
|
Line 1
|
Line 1
|
\ various tests, especially for bugs that have been fixed |
\ 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. |
\ This file is part of Gforth. |
|
|
Line 60 foo1
|
Line 60 foo1
|
addr1 false <> abort" TO does not work on locals" ; |
addr1 false <> abort" TO does not work on locals" ; |
locals-test2 |
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) |
\ multiple reveals (recursive) |
|
|
0 |
0 |
Line 101 test-only
|
Line 105 test-only
|
|
|
\ create-interpret/compile |
\ create-interpret/compile |
|
|
: constant ( n "name" -- ) |
: my-constant ( n "name" -- ) |
create-interpret/compile |
create-interpret/compile |
, |
, |
interpretation> |
interpretation> |
Line 111 compilation>
|
Line 115 compilation>
|
@ postpone literal |
@ postpone literal |
<compilation ; |
<compilation ; |
|
|
5 constant five |
5 my-constant five |
five 5 <> throw |
five 5 <> throw |
: five' five ; |
: five' five ; |
five' 5 <> throw |
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 |
\ comments across several lines |
|
|
( fjklfjlas;d |
( fjklfjlas;d |
abort" ( does not work across lines" |
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! |
\ last test! |
\ testing '(' without ')' at end-of-file |
\ testing '(' without ')' at end-of-file |