code.consxy.com Git - clnl/blob - src/test/main.lisp

   1 (in-package #:cl-nl-test)
   2
   3 (defparameter *tests* nil)
   4
   5 (defun run-and-print-test (test)
   6  (let
   7   ((green (format nil "~c[1;32m" #\Esc))
   8    (red (format nil "~c[1;31m" #\Esc))
   9    (result (funcall (cadr test))))
  10   (format t "~A- ~S ~A~c[0m~%" (if result green red) (car test) (if result "passed" "failed") #\Esc)
  11   result))
  12
  13 (defun run-tests (tests)
  14  (let
  15   ((final-result t))
  16   (loop for test in tests
  17         for result = (run-and-print-test test)
  18         do (setf final-result (and final-result result)))
  19   final-result))
  20
  21 (defun run-all-tests ()
  22  (format t "~%Here we goooooooo~%")
  23  (run-tests *tests*))
  24
  25 (defun run-tests-matching (match)
  26  (run-tests (remove-if-not (lambda (test-name) (cl-ppcre:scan (format nil "^~A$" match) test-name)) *tests* :key #'car)))
  27
  28 (defun find-test (name) (find name *tests* :test #'string= :key #'car))
  29
  30 (defun diagnose-test (name)
  31  (when (not (find-test name)) (error "Couldn't find test with name: ~A" name))
  32  (format t "----~%~A~%" (funcall (caddr (find-test name)))))
  33
  34 (defun test-commands (name)
  35  (let
  36   ((test (find-test name)))
  37   (when (not test) (error "Couldn't find test with name: ~A" name))
  38   (format t "----~%")
  39   (format t "~A~%" (funcall (fourth test)))))
  40
  41 ; To be used only with the simplest of tests, just a list of commands and a checksum of the
  42 ; world after they've been run.
  43 (defmacro defsimpletest (name commands checksum)
  44  `(progn
  45    ;(when (find-test ,name) (error "Test with name ~S already exists, abort, abort" ,name))
  46    (push
  47     (list
  48      ,name
  49      (lambda ()
  50       (cl-nl:boot)
  51       (cl-nl:run-commands ,commands)
  52       (string= ,checksum (checksum-world)))
  53      (lambda ()
  54       (cl-nl:boot)
  55       (cl-nl:run-commands ,commands)
  56       (cl-nl.nvm:export-world)
  57       )
  58      (lambda () ,commands))
  59    *tests*)))
  60
  61 (defun checksum-world ()
  62  (format nil "~{~2,'0X~}"
  63   (map 'list #'identity
  64    (ironclad:digest-sequence
  65     :sha1
  66     (map '(vector (unsigned-byte 8)) #'char-code (cl-nl.nvm:export-world))))))
  67
  68 (defun run ()
  69  (loop for str = (progn (format t "> ") (force-output) (read-line))
  70        while str
  71        do (progn (asdf:load-system :cl-nl-test) (run-tests-matching str))))