-\ @(#) t_tools.fth 97/12/10 1.1\r
-\ Test Tools for pForth\r
-\\r
-\ Based on testing tools from John Hayes\r
-\ (c) 1993 Johns Hopkins University / Applied Physics Laboratory\r
-\\r
-\ Syntax was changed to avoid conflict with { -> and } for local variables.\r
-\ Also added tracking of #successes and #errors.\r
-\r
-anew task-t_tools.fth\r
-\r
-decimal\r
-\r
-variable TEST-DEPTH\r
-variable TEST-PASSED\r
-variable TEST-FAILED\r
-\r
-: TEST{\r
- depth test-depth !\r
- 0 test-passed !\r
- 0 test-failed !\r
-;\r
-\r
-\r
-: }TEST\r
- test-passed @ 4 .r ." passed, "\r
- test-failed @ 4 .r ." failed." cr\r
-;\r
-\r
-\r
-VARIABLE actual-depth \ stack record\r
-CREATE actual-results 20 CELLS ALLOT\r
-\r
-: empty-stack \ ( ... -- ) Empty stack.\r
- DEPTH dup 0>\r
- IF 0 DO DROP LOOP\r
- ELSE drop\r
- THEN ;\r
-\r
-CREATE the-test 128 CHARS ALLOT\r
-\r
-: ERROR \ ( c-addr u -- ) Display an error message followed by\r
- \ the line that had the error.\r
- TYPE the-test COUNT TYPE CR \ display line corresponding to error\r
- empty-stack \ throw away every thing else\r
-;\r
-\r
-\r
-: T{\r
- source the-test place\r
- empty-stack\r
-;\r
-\r
-: }T{ \ ( ... -- ) Record depth and content of stack.\r
- DEPTH actual-depth ! \ record depth\r
- DEPTH 0\r
- ?DO\r
- actual-results I CELLS + !\r
- LOOP \ save them\r
-;\r
-\r
-: }T \ ( ... -- ) Compare stack (expected) contents with saved\r
- \ (actual) contents.\r
- DEPTH\r
- actual-depth @ =\r
- IF \ if depths match\r
- 1 test-passed +! \ assume will pass\r
- DEPTH 0\r
- ?DO \ for each stack item\r
- actual-results I CELLS + @ \ compare actual with expected\r
- <>\r
- IF\r
- -1 test-passed +!\r
- 1 test-failed +!\r
- S" INCORRECT RESULT: " error\r
- LEAVE\r
- THEN\r
- LOOP\r
- ELSE \ depth mismatch\r
- 1 test-failed +!\r
- S" WRONG NUMBER OF RESULTS: " error\r
- THEN\r
-;\r
+\ @(#) 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
+;
projects / pforth / blobdiff