Merge pull request #61 from philburk/docansi

[pforth] / fth / t_tools.fth

\ @(#) 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
;