\ 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.1

\ 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 } 

\ 13/1/12 mk. This source code was tested ok for CamelForth for MSP430FR5739.
\ asn_core.fr has been used for CF430FR V0.2 verification.


   \ Use terminal to send file anstester.fr down to CF430FR 
   \ on MSP-EXP430F5739 Experimenter Board.
   \ Then send file anstest_core.fr to verify CamelForth.
   \ I used 9600 8N1. 300ms line delay was ok. mk


HEX
 0 CONSTANT FALSE 
-1 CONSTANT TRUE 

\ 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 ;

: ERROR     \ ( 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
\   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
        <> 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 ;