application/octet-stream
•
3.53 KB
•
105 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; The test system for Nujel, might be removed from the stdlib entirely in the
;;; future
[require :ansi]
[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 add* [result expr]
:export
[set! test-list [cons [cons result expr] test-list]]
[set! test-count [+ test-count 1]]]
[defn reset! []
:export
[set! test-list [cons 4 '[+ 3 1]]]
[set! test-count 1]]
[defn display-results [description]
"Prints the result Message"
[efmtln "{} {} - [{} / {}] in {} ms"
[if [and [zero? error-count] [> test-count 0]]
[if [zero? success-count]
[ansi/yellow "?"]
[ansi/green "✓"]]
[ansi/red "✗"]]
description
[if [zero? success-count]
[ansi/yellow success-count]
[ansi/green success-count]]
[if [zero? error-count]
[ansi/gray error-count]
[ansi/red error-count]]
[- [time/milliseconds] nujel-start]]]
[defn test-success [res-should res-is expr]
"Should be called after a test has finished successfully"
[when print-passes
[efmtln "{} == {}\r\n{}\r\n\r\n"
[ansi/green [string/write res-is]]
[ansi/green [string/write res-should]]
[string/write expr]]]
[set! success-count [+ 1 success-count]]]
[defn test-failure [res-should res-is expr]
"Should be called if EXPR does not equal RES"
[when print-errors
[pfmtln "{} != {}\r\n{}\r\n\r\n"
[ansi/red [string/write res-is]]
[ansi/green [string/write res-should]]
[string/write expr]]]
[set! error-count [+ 1 error-count]]]
[defn run-test! [result rawexpr i]
:export
"Tests that RAWEXPR evaluates to RESULT"
[try [fn [err]
[set! +bytecompile/apply-new+ #f]
[test-failure result [list :exception-caught err] rawexpr]]
[def expr [eval rawexpr]]
[set! +bytecompile/apply-new+ #f]
[if [equal? result expr]
[test-success result expr rawexpr]
[test-failure result expr rawexpr]]]]
[defn init! [output-passes hide-errors]
:export
"Initialize the testing framework"
[set! print-errors [not [boolean hide-errors]]]
[set! print-passes [boolean output-passes]]
[set! nujel-start [time/milliseconds]]
[set! success-count 0]
[set! error-count 0]]
[defn finish! [description]
:export
[display-results description]
[return error-count]]
[defn run [output-passes hide-errors]
:export
"Run through all automated Tests"
[init!]
[doseq [cur-test test-list]
[run-test! [car cur-test]
[cdr cur-test]]]
[finish! [fmt "{} {} [{System/OS} {System/Architecture}]" [ansi/blue ":core"] [ansi/rainbow "Nujel"]]]]
[defn load-file [filename]
:export
[doseq [t [read [slurp filename]] test-list]
[when [== [car t] 'test/add]
[cdr! t]]
[add* [eval [car t]] [cons 'do [cdr t]]]]]
[reset!]
[deftest #t [lambda? test/run]]
;; [error"Evaluating comments is a terrible Idea!"] [newline] [exit 2]
