--- gforth/test/ttester.fs	2007/08/21 09:22:28	1.2
+++ gforth/test/ttester.fs	2007/11/03 08:27:14	1.9
@@ -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 02111-1307 USA.
+\ public domain
 
 \ for the rest:
-\ revised by Anton Ertl 2007-08-12, 2007-08-19
+\ revised by Anton Ertl 2007-08-12, 2007-08-19, 2007-08-28
 \ 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 drop-in 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
 \ non-portabilities and stayed as much within the CORE words as
@@ -53,11 +41,10 @@
 
 \ There are a few things to be noted:
 
-\ - Following the despicable practice of the original, this version
-\ sets the base to HEX for everything that gets loaded later.
-\ Floating-point input is ambiguous when the base is not decimal, so
-\ you have to set it to decimal yourself when you want to deal with
-\ decimal numbers.
+\ - Loading ttester.fs does not change BASE.  Loading tester.fs
+\ changes BASE to HEX (like the original tester).  Floating-point
+\ input is ambiguous when the base is not decimal, so you have to set
+\ it to decimal yourself when you want to deal with decimal numbers.
 
 \ - For FP it is often useful to use approximate equality for checking
 \ the results.  You can turn on approximate matching with SET-NEAR
@@ -72,6 +59,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
@@ -112,8 +100,7 @@ HAS-FLOATING [IF]
     \ SET THE FOLLOWING TO THE RELATIVE AND ABSOLUTE TOLERANCES YOU
     \ WANT FOR APPROXIMATE FLOAT EQUALITY, TO BE USED WITH F~ IN
     \ FNEARLY=.  KEEP THE SIGNS, BECAUSE F~ NEEDS THEM.
-    FVARIABLE FSENSITIVITY DECIMAL 1E-12 HEX FSENSITIVITY F!
-    : REL-NEAR FSENSITIVITY ;
+    FVARIABLE REL-NEAR DECIMAL 1E-12 HEX REL-NEAR F!
     FVARIABLE ABS-NEAR    DECIMAL 0E HEX ABS-NEAR F!
 
     \ WHEN EXACT? IS TRUE, }F USES FEXACTLY=, OTHERWISE FNEARLY=.
@@ -187,7 +174,7 @@ HAS-FLOATING-STACK [IF]
     : F-> ( ... -- ... )
         FDEPTH DUP ACTUAL-FDEPTH !
         START-FDEPTH @ > IF
-            FDEPTH START-FDEPTH @ DO ACTUAL-FRESULTS I FLOATS + F! LOOP
+            FDEPTH START-FDEPTH @ - 0 DO ACTUAL-FRESULTS I FLOATS + F! LOOP
         THEN ;
 
     : F} ( ... -- ... )
@@ -204,20 +191,19 @@ HAS-FLOATING-STACK [IF]
         THEN ;
 
     : F...}T ( -- )
-        FDEPTH START-FDEPTH @ = 0= IF
-            S" WRONG NUMBER OF FP RESULTS" ERROR
-        THEN
-        FCURSOR @ ACTUAL-FDEPTH @ <> IF
-            S" WRONG NUMBER OF FP RESULTS" ERROR
-        THEN ;
+        FCURSOR @ START-FDEPTH @ + ACTUAL-FDEPTH @ <> IF
+            S" NUMBER OF FLOAT RESULTS BEFORE '->' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR
+        ELSE FDEPTH START-FDEPTH @ = 0= IF
+            S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR
+        THEN THEN ;
+
     
     : FTESTER ( R -- )
-        FDEPTH 0= ACTUAL-FDEPTH @ FCURSOR @ 1+ < OR IF
-            S" WRONG NUMBER OF FP RESULTS: " ERROR EXIT
-        THEN
-        ACTUAL-FRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF
+        FDEPTH 0= ACTUAL-FDEPTH @ FCURSOR @ START-FDEPTH @ + 1+ < OR IF
+            S" NUMBER OF FLOAT RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR 
+        ELSE ACTUAL-FRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF
             S" INCORRECT FP RESULT: " ERROR
-        THEN
+        THEN THEN
         1 FCURSOR +! ;
         
 [ELSE]
@@ -227,18 +213,19 @@ HAS-FLOATING-STACK [IF]
     : F} ;
     : F...}T ;
 
+    DECIMAL
     : COMPUTE-CELLS-PER-FP ( -- U )
-        DEPTH 0E DEPTH >R FDROP R> SWAP - ;
+        DEPTH 0E DEPTH 1- >R FDROP R> SWAP - ;
+    HEX
 
     COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP
     
     : FTESTER ( R -- )
-        DEPTH CELLS-PER-FP < ACTUAL-DEPTH @ XCURSOR @ CELLS-PER-FP + < OR IF
-            S" WRONG NUMBER OF RESULTS: " ERROR EXIT
-        THEN
-        ACTUAL-RESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF
+        DEPTH CELLS-PER-FP < ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + CELLS-PER-FP + < OR IF
+            S" NUMBER OF RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT
+        ELSE ACTUAL-RESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF
             S" INCORRECT FP RESULT: " ERROR
-        THEN
+        THEN THEN
         CELLS-PER-FP XCURSOR +! ;
  [THEN]    
 
@@ -260,12 +247,12 @@ HAS-FLOATING-STACK [IF]
 ' ERROR1 ERROR-XT !
 
 : T{		\ ( -- ) SYNTACTIC SUGAR.
-   DEPTH START-DEPTH ! F{ ;
+   DEPTH START-DEPTH ! 0 XCURSOR ! F{ ;
 
 : ->		\ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
    DEPTH DUP ACTUAL-DEPTH !		\ RECORD DEPTH
    START-DEPTH @ > IF		\ IF THERE IS SOMETHING ON STACK
-       DEPTH START-DEPTH @ DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
+       DEPTH START-DEPTH @ - 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
    THEN
    F-> ;
 
@@ -284,21 +271,19 @@ HAS-FLOATING-STACK [IF]
    F} ;
 
 : ...}T ( -- )
-    DEPTH START-DEPTH @ = 0= IF
-        S" WRONG NUMBER OF RESULTS" ERROR
-    THEN
-    XCURSOR @ ACTUAL-DEPTH @ <> IF
-        S" WRONG NUMBER OF RESULTS" ERROR
-    THEN
+    XCURSOR @ START-DEPTH @ + ACTUAL-DEPTH @ <> IF
+        S" NUMBER OF CELL RESULTS BEFORE '->' DOES NOT MATCH ...}T SPECIFICATION: " ERROR
+    ELSE DEPTH START-DEPTH @ = 0= IF
+        S" NUMBER OF CELL RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR
+    THEN THEN
     F...}T ;
 
 : XTESTER ( X -- )
-    DEPTH 0= ACTUAL-DEPTH @ XCURSOR @ 1+ < OR IF
-        S" WRONG NUMBER OF RESULTS: " ERROR EXIT
-    THEN
-    ACTUAL-RESULTS XCURSOR @ CELLS + @ <> IF
+    DEPTH 0= ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + 1+ < OR IF
+        S" NUMBER OF CELL RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT
+    ELSE ACTUAL-RESULTS XCURSOR @ CELLS + @ <> IF
         S" INCORRECT CELL RESULT: " ERROR
-    THEN
+    THEN THEN
     1 XCURSOR +! ;
 
 : X}T XTESTER ...}T ;
@@ -337,3 +322,5 @@ HAS-FLOATING-STACK [IF]
    IF DUP >R TYPE CR R> >IN !
    ELSE >IN ! DROP
    THEN ;
+
+BASE !