1\ From: John Hayes S1I 2\ Subject: tester.fr 3\ Date: Mon, 27 Nov 95 13:10:09 PST 4\ john.hayes@jhuapl.edu 5\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY 6\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. 7\ VERSION 1.1 8 9\ jws notes: <> is a core ext word 10 11HEX 12 13\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY 14\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG. 15VARIABLE VERBOSE 16 TRUE VERBOSE ! 17 18: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. 19 DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ; 20 21: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY 22 \ THE LINE THAT HAD THE ERROR. 23 TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR 24 EMPTY-STACK \ THROW AWAY EVERY THING ELSE 25 break \ jws 26; 27 28VARIABLE ACTUAL-DEPTH \ STACK RECORD 29 30CREATE ACTUAL-RESULTS 20 CELLS ALLOT 31 32: { \ ( -- ) SYNTACTIC SUGAR. 33 ; 34 35: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. 36 DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH 37 ?DUP IF \ IF THERE IS SOMETHING ON STACK 38 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM 39 THEN ; 40 41: } \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED 42 \ (ACTUAL) CONTENTS. 43 DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH 44 DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK 45 0 DO \ FOR EACH STACK ITEM 46 ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED 47 <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN 48 LOOP 49 THEN 50 ELSE \ DEPTH MISMATCH 51 S" WRONG NUMBER OF RESULTS: " ERROR 52 THEN ; 53 54: TESTING \ ( -- ) TALKING COMMENT. 55 SOURCE VERBOSE @ 56 IF DUP >R TYPE CR R> >IN ! 57 ELSE >IN ! DROP 58 THEN ; 59