|
57
|
1 \ (C) 1993 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
|
|
|
2 \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
|
|
|
3 \ VERSION 1.0
|
|
|
4 HEX
|
|
|
5
|
|
|
6 \ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
|
|
|
7 \ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
|
|
|
8 VARIABLE VERBOSE
|
|
|
9 FALSE VERBOSE !
|
|
|
10
|
|
|
11 : EMPTY-STACK \ ( ... -- ) EMPTY STACK.
|
|
|
12 DEPTH ?DUP IF 0 DO DROP LOOP THEN ;
|
|
|
13
|
|
|
14 : ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
|
|
|
15 \ THE LINE THAT HAD THE ERROR.
|
|
|
16 TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR
|
|
|
17 EMPTY-STACK \ THROW AWAY EVERY THING ELSE
|
|
|
18 ;
|
|
|
19
|
|
|
20 VARIABLE ACTUAL-DEPTH \ STACK RECORD
|
|
|
21 CREATE ACTUAL-RESULTS 20 CELLS ALLOT
|
|
|
22
|
|
|
23 : { \ ( -- ) SYNTACTIC SUGAR.
|
|
|
24 ;
|
|
|
25
|
|
|
26 : -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
|
|
|
27 DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH
|
|
|
28 ?DUP IF \ IF THERE IS SOMETHING ON STACK
|
|
|
29 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
|
|
|
30 THEN ;
|
|
|
31
|
|
|
32 : } \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
|
|
|
33 \ (ACTUAL) CONTENTS.
|
|
|
34 DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH
|
|
|
35 DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK
|
|
|
36 0 DO \ FOR EACH STACK ITEM
|
|
|
37 ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED
|
|
|
38 <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
|
|
|
39 LOOP
|
|
|
40 THEN
|
|
|
41 ELSE \ DEPTH MISMATCH
|
|
|
42 S" WRONG NUMBER OF RESULTS: " ERROR
|
|
|
43 THEN ;
|
|
|
44
|
|
|
45 : TESTING \ ( -- ) TALKING COMMENT.
|
|
|
46 SOURCE VERBOSE @
|
|
|
47 IF DUP >R TYPE CR R> >IN !
|
|
|
48 ELSE >IN ! DROP
|
|
|
49 THEN ;
|
