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