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