Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | \ @(#) t_tools.fth 97/12/10 1.1 |
2 | \ Test Tools for pForth | |
3 | \ | |
4 | \ Based on testing tools from John Hayes | |
5 | \ (c) 1993 Johns Hopkins University / Applied Physics Laboratory | |
6 | \ | |
7 | \ Syntax was changed to avoid conflict with { -> and } for local variables. | |
8 | \ Also added tracking of #successes and #errors. | |
9 | ||
10 | anew task-t_tools.fth | |
11 | ||
12 | decimal | |
13 | ||
14 | variable TEST-DEPTH | |
15 | variable TEST-PASSED | |
16 | variable TEST-FAILED | |
17 | ||
18 | : TEST{ | |
19 | depth test-depth ! | |
20 | 0 test-passed ! | |
21 | 0 test-failed ! | |
22 | ; | |
23 | ||
24 | ||
25 | : }TEST | |
26 | test-passed @ 4 .r ." passed, " | |
27 | test-failed @ 4 .r ." failed." cr | |
28 | ; | |
29 | ||
30 | ||
31 | VARIABLE actual-depth \ stack record | |
32 | CREATE actual-results 20 CELLS ALLOT | |
33 | ||
34 | : empty-stack \ ( ... -- ) Empty stack. | |
35 | DEPTH dup 0> | |
36 | IF 0 DO DROP LOOP | |
37 | ELSE drop | |
38 | THEN ; | |
39 | ||
40 | CREATE the-test 128 CHARS ALLOT | |
41 | ||
42 | : ERROR \ ( c-addr u -- ) Display an error message followed by | |
43 | \ the line that had the error. | |
44 | TYPE the-test COUNT TYPE CR \ display line corresponding to error | |
45 | empty-stack \ throw away every thing else | |
46 | ; | |
47 | ||
48 | ||
49 | : T{ | |
50 | source the-test place | |
51 | empty-stack | |
52 | ; | |
53 | ||
54 | : }T{ \ ( ... -- ) Record depth and content of stack. | |
55 | DEPTH actual-depth ! \ record depth | |
56 | DEPTH 0 | |
57 | ?DO | |
58 | actual-results I CELLS + ! | |
59 | LOOP \ save them | |
60 | ; | |
61 | ||
62 | : }T \ ( ... -- ) Compare stack (expected) contents with saved | |
63 | \ (actual) contents. | |
64 | DEPTH | |
65 | actual-depth @ = | |
66 | IF \ if depths match | |
67 | 1 test-passed +! \ assume will pass | |
68 | DEPTH 0 | |
69 | ?DO \ for each stack item | |
70 | actual-results I CELLS + @ \ compare actual with expected | |
71 | <> | |
72 | IF | |
73 | -1 test-passed +! | |
74 | 1 test-failed +! | |
75 | S" INCORRECT RESULT: " error | |
76 | LEAVE | |
77 | THEN | |
78 | LOOP | |
79 | ELSE \ depth mismatch | |
80 | 1 test-failed +! | |
81 | S" WRONG NUMBER OF RESULTS: " error | |
82 | THEN | |
83 | ; |