 gforth/test/ttester.fs 2007/08/21 09:22:28 1.2
+++ gforth/test/ttester.fs 2007/08/28 19:15:03 1.4
@@ 7,26 +7,12 @@
\ VERSION 1.1
\ for the FNEARLY= stuff:
\ from ftester.fs written by David N. Williams, based on the
+\ from ftester.fs written by David N. Williams, based on the idea of
\ approximate equality in Dirk Zoller's float.4th

\ This library is free software; you can redistribute it and/or
\ modify it under the terms of the GNU Lesser General Public
\ License as published by the Free Software Foundation; either
\ version 2.1 of the License, or at your option any later version.

\ This library is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\ Lesser General Public License for more details.

\ You should have received a copy of the GNU Lesser General Public
\ License along with this library; if not, write to the Free
\ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
\ MA 021111307 USA.
+\ public domain
\ for the rest:
\ revised by Anton Ertl 20070812, 20070819
+\ revised by Anton Ertl 20070812, 20070819, 20070828
\ public domain
\ The original has the following shortcomings:
@@ 44,7 +30,9 @@
\ http://www.forth200x.org/tests/ttester.fs
\ tester.fs is intended to be a dropin replacement of the original.
\ ttester.fs is a version that uses T{ and }T instead of { and }.
+
+\ ttester.fs is a version that uses T{ and }T instead of { and } and
+\ keeps the BASE as it was before loading ttester.fs
\ In spirit of the original, I have strived to avoid any potential
\ nonportabilities and stayed as much within the CORE words as
@@ 72,6 +60,7 @@
\ system or if you need only exact matching, you can use the plain }T
\ instead.
+BASE @
HEX
\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
@@ 227,8 +216,10 @@ HASFLOATINGSTACK [IF]
: F} ;
: F...}T ;
+ DECIMAL
: COMPUTECELLSPERFP (  U )
 DEPTH 0E DEPTH >R FDROP R> SWAP  ;
+ DEPTH 0E DEPTH 1 >R FDROP R> SWAP  ;
+ HEX
COMPUTECELLSPERFP CONSTANT CELLSPERFP
@@ 260,7 +251,7 @@ HASFLOATINGSTACK [IF]
' ERROR1 ERRORXT !
: T{ \ (  ) SYNTACTIC SUGAR.
 DEPTH STARTDEPTH ! F{ ;
+ DEPTH STARTDEPTH ! 0 XCURSOR ! F{ ;
: > \ ( ...  ) RECORD DEPTH AND CONTENT OF STACK.
DEPTH DUP ACTUALDEPTH ! \ RECORD DEPTH
@@ 337,3 +328,5 @@ HASFLOATINGSTACK [IF]
IF DUP >R TYPE CR R> >IN !
ELSE >IN ! DROP
THEN ;
+
+BASE !
\ No newline at end of file