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