diff options
author | Clyne Sullivan <clyne@bitgloo.com> | 2023-03-11 10:26:02 -0500 |
---|---|---|
committer | Clyne Sullivan <clyne@bitgloo.com> | 2023-03-11 10:26:02 -0500 |
commit | 400e277b0c111739ea4ed426328cbcc4472744df (patch) | |
tree | 5b32bd7d5820d6cdc16838dac14ca616bd44dc5a /test/tester.fr | |
parent | e41b124320011cb1451f9869710a110058ee95aa (diff) |
make forth and msp430 folders
Diffstat (limited to 'test/tester.fr')
-rw-r--r-- | test/tester.fr | 66 |
1 files changed, 0 insertions, 66 deletions
diff --git a/test/tester.fr b/test/tester.fr deleted file mode 100644 index 2cf108d..0000000 --- a/test/tester.fr +++ /dev/null @@ -1,66 +0,0 @@ -\ From: John Hayes S1I -\ Subject: tester.fr -\ Date: Mon, 27 Nov 95 13:10:09 PST - -\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY -\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. -\ VERSION 1.2 - -\ 24/11/2015 Replaced Core Ext word <> with = 0= -\ 31/3/2015 Variable #ERRORS added and incremented for each error reported. -\ 22/1/09 The words { and } have been changed to T{ and }T respectively to -\ agree with the Forth 200X file ttester.fs. This avoids clashes with -\ locals using { ... } and the FSL use of } - -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 ! -\ TRUE VERBOSE ! - -: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. - DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ; - -VARIABLE #ERRORS 0 #ERRORS ! - -: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY - \ THE LINE THAT HAD THE ERROR. - CR TYPE SOURCE TYPE \ DISPLAY LINE CORRESPONDING TO ERROR - EMPTY-STACK \ THROW AWAY EVERY THING ELSE - #ERRORS @ 1 + #ERRORS ! -\ QUIT \ *** Uncomment this line to QUIT on an error -; - -VARIABLE ACTUAL-DEPTH \ STACK RECORD -CREATE ACTUAL-RESULTS 20 CELLS ALLOT - -: T{ \ ( -- ) SYNTACTIC SUGAR. - ; - -: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. - DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH - ?DUP IF \ IF THERE IS SOMETHING ON STACK - 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM - THEN ; - -: }T \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED - \ (ACTUAL) CONTENTS. - DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH - DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK - 0 DO \ FOR EACH STACK ITEM - ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED - = 0= IF S" INCORRECT RESULT: " ERROR LEAVE THEN - LOOP - THEN - ELSE \ DEPTH MISMATCH - S" WRONG NUMBER OF RESULTS: " ERROR - THEN ; - -: TESTING \ ( -- ) TALKING COMMENT. - SOURCE VERBOSE @ - IF DUP >R TYPE CR R> >IN ! - ELSE >IN ! DROP [CHAR] * EMIT - THEN ; - |