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)
      :export
      "Tests that RAWEXPR evaluates to RESULT"
      (try (fn (err)
             (test-failure result (list :exception-caught err) rawexpr))
           (def expr (eval rawexpr))
           (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 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 add-builtin-tests ()
      :export
      (doseq (test-funs (-> (symbol-table)
                            (map resolve-or-nil)
                            (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)