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