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

   1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
   2 (in-package #:sheep-test)
   3
   4 (defvar *tests* nil)
   5
   6 ; This really is just here to check against regressions
   7 (defun run-all-tests ()
   8  (let
   9   ((results (mapcar #'funcall (reverse *tests*))))
  10   (every #'identity results)))
  11
  12 (defun slurp-file (filename &key (element-type 'character) (sequence-type 'string))
  13  (with-open-file (str filename :element-type element-type)
  14   (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq)))
  15
  16 (defmacro deftest (name f)
  17  `(push
  18    (lambda ()
  19     (let
  20      ((success
  21        (handler-case
  22         (funcall ,f)
  23         (error (e) (format t "Got unexpected error in tests: ~A" e)))))
  24      (if success
  25       (format t "~c[1;32m- ~A passed~c[0m~%" #\Esc ,name #\Esc)
  26       (format t "~c[1;31m- ~A failed~c[0m~%" #\Esc ,name #\Esc))
  27      success))
  28    *tests*))
  29
  30 (defmacro defsuccesstest (pkg source target)
  31  `(deftest
  32    ,source
  33    (lambda ()
  34     (handler-case
  35      (progn
  36       (load ,source)
  37       (string= (slurp-file ,target) (sheep:export-package ,pkg)))
  38      (sheep:validation-failure (vf)
  39       (format t "Validation failure gotten: ~A~%"
  40        (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))))))
  41
  42 (defmacro deffailuretest (pkg source expected)
  43  `(deftest
  44    ,source
  45    (lambda ()
  46     (progn
  47      (load ,source)
  48      (let
  49       ((result (sheep:validate-package ,pkg)))
  50       (or
  51        (equal ,expected result)
  52        (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected)))))))
  53
  54 (defmacro deffailure-func-test (name doc expected)
  55  `(deftest
  56    ,(format nil "Func - ~A" name)
  57    (lambda ()
  58     (handler-case
  59      (progn
  60       (funcall
  61        (symbol-function (find-symbol "INTERNAL-DOC->AST" :sheep-func))
  62        'unused
  63        ,doc)
  64       nil)
  65      (sheep:validation-failure (vf)
  66       (let
  67        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
  68        (or
  69         (string= ,expected result)
  70         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
  71
  72 (defmacro deffailure-var-test (name doc expected)
  73  `(deftest
  74    ,(format nil "Var - ~A" name)
  75    (lambda ()
  76     (handler-case
  77      (progn
  78       (funcall
  79        (symbol-function (find-symbol "INTERNAL-DOC->AST" :sheep-var))
  80        '*unused*
  81        ,doc)
  82       nil)
  83      (sheep:validation-failure (vf)
  84       (let
  85        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
  86        (or
  87         (string= ,expected result)
  88         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
  89
  90 (defsuccesstest :success1 "resources/success1.lisp" "resources/success1.md")
  91 (deffailuretest :emptydocs "resources/emptydocs.lisp"
  92  `((:failure :emptydocs "Package EMPTYDOCS has no documentation")
  93    (:failure ,(intern "NO-DOC-CONDITION" :emptydocs) "Symbol NO-DOC-CONDITION has no documentation")
  94    (:failure ,(intern "NO-DOC-FUNC" :emptydocs) "Symbol NO-DOC-FUNC has no documentation")))