1.1--- a/fig/tests/tester.fr	Sat May 27 21:07:55 2023 -0400
     1.2+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3@@ -1,66 +0,0 @@
     1.4-\ From: John Hayes S1I
     1.5-\ Subject: tester.fr
     1.6-\ Date: Mon, 27 Nov 95 13:10:09 PST  
     1.7-
     1.8-\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
     1.9-\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
    1.10-\ VERSION 1.2
    1.11-
    1.12-\ 24/11/2015 Replaced Core Ext word <> with = 0=
    1.13-\ 31/3/2015 Variable #ERRORS added and incremented for each error reported.
    1.14-\ 22/1/09 The words { and } have been changed to T{ and }T respectively to
    1.15-\ agree with the Forth 200X file ttester.fs. This avoids clashes with
    1.16-\ locals using { ... } and the FSL use of } 
    1.17-
    1.18-HEX
    1.19-
    1.20-\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
    1.21-\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
    1.22-VARIABLE VERBOSE
    1.23-   FALSE VERBOSE !
    1.24-\   TRUE VERBOSE !
    1.25-
    1.26-: EMPTY-STACK   \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
    1.27-   DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ;
    1.28-
    1.29-VARIABLE #ERRORS 0 #ERRORS !
    1.30-
    1.31-: ERROR      \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
    1.32-      \ THE LINE THAT HAD THE ERROR.
    1.33-   CR TYPE SOURCE TYPE       \ DISPLAY LINE CORRESPONDING TO ERROR
    1.34-   EMPTY-STACK               \ THROW AWAY EVERY THING ELSE
    1.35-   #ERRORS @ 1 + #ERRORS !
    1.36-\   QUIT  \ *** Uncomment this line to QUIT on an error
    1.37-;
    1.38-
    1.39-VARIABLE ACTUAL-DEPTH         \ STACK RECORD
    1.40-CREATE ACTUAL-RESULTS 20 CELLS ALLOT
    1.41-
    1.42-: T{      \ ( -- ) SYNTACTIC SUGAR.
    1.43-   ;
    1.44-
    1.45-: ->      \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
    1.46-   DEPTH DUP ACTUAL-DEPTH !      \ RECORD DEPTH
    1.47-   ?DUP IF            \ IF THERE IS SOMETHING ON STACK
    1.48-      0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
    1.49-   THEN ;
    1.50-
    1.51-: }T      \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
    1.52-      \ (ACTUAL) CONTENTS.
    1.53-   DEPTH ACTUAL-DEPTH @ = IF      \ IF DEPTHS MATCH
    1.54-      DEPTH ?DUP IF         \ IF THERE IS SOMETHING ON THE STACK
    1.55-         0  DO            \ FOR EACH STACK ITEM
    1.56-           ACTUAL-RESULTS I CELLS + @   \ COMPARE ACTUAL WITH EXPECTED
    1.57-           = 0= IF S" INCORRECT RESULT: " ERROR LEAVE THEN
    1.58-         LOOP
    1.59-      THEN
    1.60-   ELSE               \ DEPTH MISMATCH
    1.61-      S" WRONG NUMBER OF RESULTS: " ERROR
    1.62-   THEN ;
    1.63-
    1.64-: TESTING   \ ( -- ) TALKING COMMENT.
    1.65-  SOURCE VERBOSE @
    1.66-   IF DUP >R TYPE CR R> >IN !
    1.67-   ELSE >IN ! DROP [CHAR] * EMIT
    1.68-   THEN ;
    1.69-