--- gforth/test/tester.fs	2007/08/12 13:13:20	1.3
+++ gforth/test/tester.fs	2007/08/28 19:15:03	1.8
@@ -1,136 +1,12 @@
-\ From: John Hayes S1I
-\ Subject: tester.fr
-\ Date: Mon, 27 Nov 95 13:10:09 PST  
+\ drop-in replacement for John Hayes' tester
 
-\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
-\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
-\ VERSION 1.1
+\ This file is in the public domain. NO WARRANTY.
+\ Note licensing for ttester.fs
 
-\ revised by Anton Ertl 2007-08-12
-\   added fp comparisons (note: BASE is HEX after loading this file)
-\         environmental dependency on separate fp stack
-\         the sensitivity of the fp comparison is determined by FSENSITIVITY
-\   added support for non-empty stack at the start
-HEX
-
-\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
-\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
-VARIABLE VERBOSE
-   FALSE VERBOSE !
-
-VARIABLE ACTUAL-DEPTH			\ STACK RECORD
-CREATE ACTUAL-RESULTS 20 CELLS ALLOT
-VARIABLE START-DEPTH
-VARIABLE ERROR-XT
-
-: ERROR ERROR-XT @ EXECUTE ;
-
-: "FLOATING" S" FLOATING" ; \ ONLY COMPILED S" IN CORE
-: "FLOATING-STACK" S" FLOATING-STACK" ;
-"FLOATING" ENVIRONMENT? [IF]
-    [IF]
-        "FLOATING-STACK" ENVIRONMENT? [IF]
-            [IF]
-                TRUE
-            [ELSE]
-                FALSE
-            [THEN]
-        [ELSE] \ WE DON'T KNOW WHETHER THE FP STACK IS SEPARATE
-            TRUE \ SAFER CHOICE TO ASSUME IT IS
-        [THEN]  
-    [ELSE]
-        FALSE
-    [THEN]
-[ELSE]
-    FALSE
-[THEN]
-[IF] \ WE HAVE FP WORDS AND A SEPARATE FP STACK
-    FVARIABLE FSENSITIVITY -1E-12 FSENSITIVITY F!
-    VARIABLE ACTUAL-FDEPTH
-    CREATE ACTUAL-FRESULTS 20 FLOATS ALLOT
-    VARIABLE START-FDEPTH
-
-    : EMPTY-FSTACK ( ... -- ... )
-        FDEPTH START-FDEPTH @ < IF
-            FDEPTH START-FDEPTH @ SWAP DO 0E LOOP
-        THEN
-        FDEPTH START-FDEPTH @ > IF
-            FDEPTH START-FDEPTH @ DO FDROP LOOP
-        THEN ;
-
-    : F{ ( -- )
-        FDEPTH START-FDEPTH ! ;
-
-    : F-> ( ... -- ... )
-        FDEPTH DUP ACTUAL-FDEPTH !
-        START-FDEPTH @ > IF
-            FDEPTH START-FDEPTH @ DO ACTUAL-FRESULTS I FLOATS + F! LOOP
-        THEN ;
+S" ./ttester.fs" INCLUDED
 
-    : F} ( ... -- ... )
-        FDEPTH ACTUAL-FDEPTH @ = IF
-            FDEPTH START-FDEPTH @ > IF
-                FDEPTH START-FDEPTH @ DO
-                    ACTUAL-FRESULTS I FLOATS + F@
-                    FSENSITIVITY F@ F~ INVERT IF
-                        S" INCORRECT RESULT: " ERROR LEAVE
-                    THEN
-                LOOP
-            THEN
-        ELSE
-            S" WRONG NUMBER OF RESULTS: " ERROR
-        THEN ;
-[ELSE]
-    : EMPTY-FSTACK ;
-    : F{ ;
-    : F-> ;
-    : F} ;
-[THEN]    
+: { T{ ;
 
-: EMPTY-STACK	\ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
-    DEPTH START-DEPTH @ < IF
-        DEPTH START-DEPTH @ SWAP DO 0 LOOP
-    THEN
-    DEPTH START-DEPTH @ > IF
-        DEPTH START-DEPTH @ DO DROP LOOP
-    THEN
-    EMPTY-FSTACK ;
-
-: ERROR1	\ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
-		\ THE LINE THAT HAD THE ERROR.
-   TYPE SOURCE TYPE CR			\ DISPLAY LINE CORRESPONDING TO ERROR
-   EMPTY-STACK				\ THROW AWAY EVERY THING ELSE
-;
-
-' ERROR1 ERROR-XT !
-
-: {		\ ( -- ) SYNTACTIC SUGAR.
-   DEPTH START-DEPTH ! 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
-   THEN
-   F-> ;
-
-: }		\ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
-		\ (ACTUAL) CONTENTS.
-   DEPTH ACTUAL-DEPTH @ = IF		\ IF DEPTHS MATCH
-      DEPTH START-DEPTH @ > IF		\ IF THERE IS SOMETHING ON THE STACK
-         DEPTH START-DEPTH @ DO		\ FOR EACH STACK ITEM
-	    ACTUAL-RESULTS I CELLS + @	\ COMPARE ACTUAL WITH EXPECTED
-	    <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
-	 LOOP
-      THEN
-   ELSE					\ DEPTH MISMATCH
-      S" WRONG NUMBER OF RESULTS: " ERROR
-   THEN
-   F} ;
-
-: TESTING	\ ( -- ) TALKING COMMENT.
-   SOURCE VERBOSE @
-   IF DUP >R TYPE CR R> >IN !
-   ELSE >IN ! DROP
-   THEN ;
+: } }T ;
 
+HEX