--- gforth/test/tester.fs	2007/08/12 13:48:53	1.5
+++ gforth/test/tester.fs	2007/08/28 19:15:03	1.8
@@ -1,172 +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
-\ The original has two shortcomings:
+S" ./ttester.fs" INCLUDED
 
-\ - It does not work as expected if the stack is non-empty before the {.
+: { T{ ;
 
-\ - It does not check FP results if the system has a separate FP stack.
+: } }T ;
 
-\ I have revised it to address both shortcomings.  You can find the
-\ result at
-
-\ http://www.forth200x.org/tests/tester.fs
-
-\ It is intended to be a drop-in replacement of the original.
-
-\ In spirit of the original, I have strived to avoid any potential
-\ non-portabilities and stayed as much within the CORE words as
-\ possible; e.g., FLOATING words are used only if the FLOATING wordset
-\ is present and the FP stack is separate.
-
-\ 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.
-
-\ - The separate-FP-stack code has an fvariable FSENSITIVITY that allows
-\   approximate matching of FP results (it's used as the r3 parameter of
-\   F~).  However, that's used only in the separate-fp-stack case.  With
-\   a shared-fp-stack you get exact matching in any case (actually
-\   FSENSITIVITY variable is not even defined in that case).  So if you
-\   define an FP test case and want to support shared-FP-stack systems,
-\   better do the approximate matching yourself.  E.g., instead of
-
-\   -1e-12 fsensitivity f!
-\   { ... computation ... -> 2.345678901e }
-
-\   write
-
-\   { ... computation ... 2.345678901e -1e-12 f~ -> true }
 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 DECIMAL 0E HEX 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 ;
-
-    : 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]    
-
-: 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 ;
-