application/octet-stream
•
4.41 KB
•
118 lines
; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
; This project uses the MIT license, a copy should be included under /LICENSE
[def test-context "Nujel"]
[defn test/reset []
[set! test-list #nil]
[set! test-count 0]
[test/add 4 [+ 3 1]]]
[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]
[defn test/add* [result expr]
[set! test-list [cons [cons result expr] test-list]]
[set! test-count [+ test-count 1]]]
[defmacro test/add [result . expr]
"Add a test where EXPR must eval to RESULT"
`[test/add* ~result ~[list 'quote [cons 'do expr]]]]
[defn display-results []
"Prints the result Message"
[random/seed-initialize!]
[efmtln "{test-context} [{System/OS} {System/Architecture}] - {} - [{} / {}] in {} ms - {}"
[if [and [zero? error-count] [> test-count 0]]
"Success"
"Failed!"]
[ansi-green success-count]
[ansi-red error-count]
[- [time/milliseconds] nujel-start]
[if [and [zero? error-count] [> test-count 0]]
[ansi-rainbow "Everything is working, very nice!"]
[ansi-red "Better fix those!"]]]]
[defn test-success [res-should res-is expr i]
"Should be called after a test has finished successfully"
[when print-passes
[efmtln "{} == {}\r\n{}\r\n\r\n"
[ansi-green [str/write res-is]]
[ansi-green [str/write res-should]]
[str/write expr]]]
[set! success-count [+ 1 success-count]]]
[defn test-failure [res-should res-is expr i]
"Should be called if EXPR does not equal RES"
[when print-errors
[pfmtln "{} != {}\r\n{}\r\n\r\n"
[ansi-red [str/write res-is]]
[ansi-green [str/write res-should]]
[str/write expr]]]
[set! error-count [+ 1 error-count]]]
[defn test-bytecode [result rawexpr i]
"Tests that RAWEXPR evaluates to RESULT when run through the bytecode interpreter"
[try [fn [err] [test-failure result [list :exception-caught err] rawexpr i]]
[def expr [byterun rawexpr]]
[if [equal? result expr]
[test-success result expr rawexpr i]
[test-failure result expr rawexpr i]]]]
[defn test-default [result rawexpr i]
"Tests that RAWEXPR evaluates to RESULT"
[try [fn [err]
[display/error err]
[test-failure result [list :exception-caught err] rawexpr i]]
[def expr [byterun rawexpr]]
[if [equal? result expr]
[test-success result expr rawexpr i]
[test-failure result expr rawexpr i]]]]
[defn test-forked [nujel-runtime]
[fn [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]]
[when-not [string? result]
[set! expr [car [read expr]]]]
[if [and [zero? [car eval-result]]
[equal? result expr]]
[test-success result expr rawexpr i]
[test-failure result expr rawexpr i]]]]
[defn test-run-real [test]
[set! nujel-start [time/milliseconds]]
[set! success-count 0]
[set! error-count 0]
[def i [+ test-count 1]]
[for-in [cur-test test-list]
[test [car cur-test] [cdr cur-test] [-- i]]]
[display-results]
error-count]
[defn 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]]
[defn test-run-bytecode [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-bytecode]]
[defn 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]]]
[test/reset]
; [error"Evaluating comments is a terrible Idea!"] [newline] [exit 2]
