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
  20        (handler-case
  21         (funcall ,f)
  22         (error (e) (format t "Got unexpected error in tests: ~A" e)))))
  23      (if success
  24       (format t "~c[1;32m- ~A passed~c[0m~%" #\Esc ,name #\Esc)
  25       (format t "~c[1;31m- ~A failed~c[0m~%" #\Esc ,name #\Esc))
  26      success))
  27    *tests*))
  28
  29 (defmacro defsuccesstest (pkg source target)
  30  `(deftest
  31    ,source
  32    (lambda ()
  33     (handler-case
  34      (progn
  35       (load ,source)
  36       (string= (slurp-file ,target) (docgen:export-package ,pkg)))
  37      (docgen:validation-failure (vf)
  38       (format t "Validation failure gotten: ~A~%"
  39        (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))))))
  40
  41 (defmacro deffailuretest (pkg source expected)
  42  `(deftest
  43    ,source
  44    (lambda ()
  45     (progn
  46      (load ,source)
  47      (let
  48       ((result (docgen:validate-package ,pkg)))
  49       (or
  50        (equal ,expected result)
  51        (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected)))))))
  52
  53 (defmacro deffailure-func-test (name doc expected)
  54  `(deftest
  55    ,(format nil "Func - ~A" name)
  56    (lambda ()
  57     (handler-case
  58      (progn
  59       (funcall
  60        (symbol-function (find-symbol "INTERNAL-DOC->AST" :docgen-func))
  61        'unused
  62        ,doc)
  63       nil)
  64      (docgen:validation-failure (vf)
  65       (let
  66        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))
  67        (or
  68         (string= ,expected result)
  69         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
  70
  71 (defmacro deffailure-var-test (name doc expected)
  72  `(deftest
  73    ,(format nil "Var - ~A" name)
  74    (lambda ()
  75     (handler-case
  76      (progn
  77       (funcall
  78        (symbol-function (find-symbol "INTERNAL-DOC->AST" :docgen-var))
  79        '*unused*
  80        ,doc)
  81       nil)
  82      (docgen:validation-failure (vf)
  83       (let
  84        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))
  85        (or
  86         (string= ,expected result)
  87         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
  88
  89 (defsuccesstest :success1 "resources/success1.lisp" "resources/success1.md")
  90 (deffailuretest :emptydocs "resources/emptydocs.lisp"
  91  `((:failure :emptydocs "Package EMPTYDOCS has no documentation")
  92    (:failure ,(intern "NO-DOC-CONDITION" :emptydocs) "Symbol NO-DOC-CONDITION has no documentation")
  93    (:failure ,(intern "NO-DOC-FUNC" :emptydocs) "Symbol NO-DOC-FUNC has no documentation")))