Login
7 branches 0 tags
Ben (RPI 4) Added [symbol-search] and [resolves?], removed cl* cb5bf2f 4 years ago 160 Commits
nujel / stdlib / 0_testing.nuj
[def test-context "Nujel"]

[def test-add]
[def test-run]
[def test-run-forked]
[let*
        [def test-list   #nil]
        [def test-count     0]
        [def nujel-start    0]
        [def success-count  0]
        [def error-count    0]
        [def print-errors  #t]
        [def print-passes  #f]

        [set! test-add [λ [result @...expr]
                "Add a test where ...EXPR must eval to RESULT"
                [set! test-list [cons [cons result [cons 'do @...expr]] test-list]]
                [set! test-count [+ test-count 1]]
        ]]
        [defun display-results []
                "Prints the result Message"
                [random/seed-initialize!]
                [error [cat test-context
                                " ["
                                [ansi-green success-count]
                                " / "
                                [ansi-red error-count]
                                "] in "
                                [- [time/milliseconds] nujel-start]
                                "ms - "
                                [if [zero? error-count]
                                    [ansi-rainbow "Everything is working, very nice!"]
                                    [ansi-red "Better fix those!"]]
                                "\r\n"]]
        ]
        [defun test-success [res-should res-is expr i]
                "Should be called after a test has finished successfully"
                [when print-passes [error [cat "stdlib/tests.nuj:" i ":1: "
                            [ansi-green "[PASS] -> "]
                                    [ansi-green [str/write res-is]]
                                    " != "
                                    [ansi-green [str/write res-should]]
                                    "\r\n"
                                    [str/write expr]
                                    "\r\n\r\n"]]]
                [set! success-count [++ success-count]]
        ]
        [defun test-failure [res-should res-is expr i]
                "Should be called if EXPR does not equal RES"
                [when print-errors [error [cat "stdlib/tests.nuj:" i ":1: "
                            [ansi-red "[FAIL] -> "]
                                    [ansi-red [str/write res-is]]
                                    " != "
                                    [ansi-green [str/write res-should]]
                                    "\r\n"
                                    [str/write expr]
                                    "\r\n\r\n"]]]
                [set! error-count [++ error-count]]
        ]
        [defun test-default [result rawexpr i]
                "Tests that RAWEXPR evaluates to RESULT"
                [try [λ [err] [test-failure result err rawexpr i]]
                        [def expr [eval rawexpr]]
                        [def pred? eq?]
                        [when [string? result]
                              [set! expr [str/write expr]]]
                        [when [pair? result]
                              [set! pred? list-equal?]]
                        [[if [pred? result expr] test-success test-failure] result expr rawexpr i]
                ]
        ]
        [defun test-forked [nujel-runtime]
                [λ [result rawexpr i]
                        "Tests that RAWEXPR evaluates to RESULT in a separate runtime"
                        [def eval-result [eval/forked nujel-runtime rawexpr]]
                        [def expr [cdr eval-result]]
                        [def pred? eq?]
                        [unless [string? result]
                                [set! expr [car [read expr]]]
                        ]
                        [when [pair? result]
                              [set! pred? list-equal?]
                        ]
                        [[if [and [zero? [car eval-result]]
                                  [pred? result expr]]
                             test-success
                             test-failure]
                         result expr rawexpr i]
        ]]
        [defun test-run-iter [test l i]
                "Recurse through LIST and runs eatch test"
                [cond [[nil? l] #t]
                       [#t [test [caar l] [cdar l] i]
                           [test-run-iter test [cdr l] [- i 1]]]]
        ]
        [defun test-run-real [test]
                [set! nujel-start    [time/milliseconds]]
                [set! success-count  0]
                [set! error-count    0]
                [test-run-iter test test-list test-count]
                [display-results]
                error-count
        ]
        [set! test-run [λ [output-passes hide-errors]
                "Run through all automated Tests"
                [set! print-errors  [not [bool hide-errors]]]
                [set! print-passes  [bool output-passes]]
                [test-run-real test-default]
        ]]
        [set! test-run-forked [λ [nujel-runtime output-passes hide-errors]
                "Run through all automated Tests in a separate runtime"
                [set! print-errors  [not [bool hide-errors]]]
                [set! print-passes  [bool output-passes]]
                [test-run-real [test-forked nujel-runtime]]
        ]]
]

; [error"Evaluating comments is a terrible Idea!"] [newline] [exit 2]