--- gforth/test/other.fs 1998/12/08 22:03:16 1.9 +++ gforth/test/other.fs 2007/12/31 19:02:25 1.24 @@ -1,12 +1,12 @@ \ various tests, especially for bugs that have been fixed -\ Copyright (C) 1997,1998 Free Software Foundation, Inc. +\ Copyright (C) 1997,1998,2000,2003,2007 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License -\ as published by the Free Software Foundation; either version 2 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ 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. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ combination of marker and locals marker foo1 @@ -67,12 +66,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 +128,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