\ 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.1HEX \ 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 ! : 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; VARIABLE ACTUAL-DEPTH           \ STACK RECORDCREATE ACTUAL-RESULTS 20 CELLS ALLOT : {     \ ( -- ) 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 ; : }     \ ( ... -- ) 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   THEN ;