punyforth/generic/forth/punit.forth at master · ChiangFamily/punyforth · GitHub

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
84
85
86
87
88
89
90
marker: -punit

\ Asserts that the top-most item of the stack is true.
: assert ( bool -- | throws:EASSERT ) invert if EASSERT throw then ;

\ Asserts that two top-most items on the stack are equal.
: =assert ( n1 n2 -- | throws:EASSERT )
    2dup <> if
        swap print: '(' . space . print: ' <>)'
        EASSERT throw
    else
        2drop
    then ;

: test? ( link -- bool )
    ['] link>name
    ['] link>len bi 5 <= if
        FALSE
    else
        TRUE
        over 0 + c@ [ char: t ] literal = and
        over 1 + c@ [ char: e ] literal = and
        over 2 + c@ [ char: s ] literal = and
        over 3 + c@ [ char: t ] literal = and
        over 4 + c@ [ char: : ] literal = and
    then
    nip ;

3 byte-array: test-report
: passed ( -- n ) 0 test-report ;
: failed ( -- n ) 1 test-report ;
: errors ( -- n ) 2 test-report ;

: test-run ( link -- )
    dup link-type
    link>xt catch
    case
        0 of
            cr
            1 passed c+!
        endof
        EASSERT of
            println: " FAIL"
            1 failed c+!
        endof
        print: " ERROR: " ex-type cr
        1 errors c+!
    endcase ;

: test-reset ( -- )
    0 passed c! 0 failed c! 0 errors c! ;

: test-report ( -- )
    passed c@ failed c@ errors c@ + + . print: " tests, "
    passed c@ . print: " passed, "
    failed c@ . print: " failed, "
    errors c@ . print: " errors"
    cr
    errors c@ 0= failed c@ 0= and if
        println: "All passed"
    else
        println: "There were failures"
    then
    cr ;

\ Runs all unit tests then prints out a test report.
\ Words with name starting with test: prefix are treated as unit tests.
: test ( -- )
    cr
    test-reset
    lastword
    begin
        dup 0<>
    while
        dup test? if
            dup test-run
        then
        @
    repeat
    drop
    test-report ;

\ Runs a single unit tests then prints out the test report.
: test: ( "testname" -- )
    cr test-reset
    word find dup 0<> if
        test-run
    else
        drop println: "No such test"
    then ;