Ben / Nujel

;;; 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!]

[defn resolve-or-null [sym]
      [if [resolves? sym root-closure]
          [resolve sym root-closure]
          #nil]]

[defn add-builtin-tests []
      :export
      [doseq [test-funs [-> [symbol-table]
                            [map resolve-or-null]
                            [filter callable?]
                            [map [fn [a] [meta a :tests]]]
                            [filter identity]]]
             [doseq [fun test-funs]
                    [add* [car fun] [cadr fun]]]]]

[deftest #t [lambda? test/run]]
;; [error"Evaluating comments is a terrible Idea!"] [newline] [exit 2]