--- gforth/test/other.fs 1998/12/08 22:03:16 1.9 +++ gforth/test/other.fs 2003/01/06 11:18:59 1.21 @@ -1,6 +1,6 @@ \ various tests, especially for bugs that have been fixed -\ Copyright (C) 1997,1998 Free Software Foundation, Inc. +\ Copyright (C) 1997,1998,2000 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -16,7 +16,7 @@ \ You should have received a copy of the GNU General Public License \ along with this program; if not, write to the Free Software -\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. \ combination of marker and locals marker foo1 @@ -67,12 +67,12 @@ locals-test2 \ multiple reveals (recursive) 0 -: xxx recursive ; .s +: xxx recursive ; throw \ if the TOS is not 0, throw an error \ look for primitives -' + look 0= throw ( nt ) +' + xt>threaded threaded>name dup 0= throw ( nt ) s" +" find-name <> throw \ represent @@ -129,6 +129,51 @@ 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