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

   1 (in-package #:docgen-test)
   2
   3 (defvar *tests* nil)
   4
   5 ; This really is just here to check against regressions
   6 (defun run-all-tests ()
   7  (let
   8   ((results (mapcar #'funcall (reverse *tests*))))
   9   (every #'identity results)))
  10
  11 (defun slurp-file (filename &key (element-type 'character) (sequence-type 'string))
  12  (with-open-file (str filename :element-type element-type)
  13   (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq)))
  14
  15 (defmacro deftest (name f)
  16  `(push
  17    (lambda ()
  18     (let
  19      ((success (funcall ,f)))
  20      (if success
  21       (format t "~c[1;32m- ~A passed~c[0m~%" #\Esc ,name #\Esc)
  22       (format t "~c[1;31m- ~A failed~c[0m~%" #\Esc ,name #\Esc))
  23      success))
  24    *tests*))
  25
  26 (defmacro defsuccesstest (pkg source target)
  27  `(deftest
  28    ,source
  29    (lambda ()
  30     (handler-case
  31      (progn
  32       (load ,source)
  33       (string= (slurp-file ,target) (docgen:export-package ,pkg)))
  34      (docgen:validation-failure (vf)
  35       (format t "Error gotten: ~A~%"
  36        (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))
  37      (error (e) (format t "Error gotten: ~A~%" e))))))
  38
  39 (defmacro deffailure-func-test (name doc expected)
  40  `(deftest
  41    ,name
  42    (lambda ()
  43     (handler-case
  44      (progn
  45       (funcall
  46        (symbol-function (find-symbol "INTERNAL-DOC->AST" :docgen-func))
  47        'unused
  48        ,doc)
  49       nil)
  50      (docgen:validation-failure (vf)
  51       (let
  52        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))
  53        (or
  54         (string= ,expected result)
  55         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
  56
  57 (defsuccesstest :success1 "resources/success1.lisp" "resources/success1.md")