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 (defparameter *tests* nil)
   5
   6 ; Used just for tests
   7 (defstruct unused-struc)
   8
   9 ; This really is just here to check against regressions
  10 (defun run-all-tests ()
  11  (let
  12   ((results (mapcar #'funcall (reverse *tests*))))
  13   (every #'identity results)))
  14
  15 (defun slurp-file (filename &key (element-type 'character) (sequence-type 'string))
  16  (with-open-file (str filename :element-type element-type)
  17   (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq)))
  18
  19 (defmacro deftest (name f)
  20  `(push
  21    (lambda ()
  22     (let
  23      ((success
  24        (handler-case
  25         (funcall ,f)
  26         (error (e) (format t "Got unexpected error in tests: ~A" e)))))
  27      (if success
  28       (format t "~c[1;32m- ~A passed~c[0m~%" #\Esc ,name #\Esc)
  29       (format t "~c[1;31m- ~A failed~c[0m~%" #\Esc ,name #\Esc))
  30      success))
  31    *tests*))
  32
  33 (defmacro defsuccesstest (pkg source target)
  34  `(deftest
  35    ,source
  36    (lambda ()
  37     (handler-case
  38      (progn
  39       (load ,source)
  40       (sheep:pretty-print-validate-packages ,pkg)
  41       (string= (slurp-file ,target) (sheep:export-package ,pkg)))
  42      (sheep:validation-failure (vf)
  43       (format t "Validation failure gotten: ~A~%"
  44        (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))))))
  45
  46 (defmacro deffailuretest (pkg source expected)
  47  `(deftest
  48    ,source
  49    (lambda ()
  50     (progn
  51      (load ,source)
  52      (let
  53       ((result (sheep:validate-package ,pkg)))
  54       (let
  55        ((*error-output* (make-broadcast-stream))
  56         (*standard-output* (make-broadcast-stream)))
  57        (sheep:pretty-print-validate-packages ,pkg))
  58       (or
  59        (equal ,expected result)
  60        (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected)))))))
  61
  62 (defmacro deffailure-func-test (name doc expected)
  63  `(deftest
  64    ,(format nil "Func - ~A" name)
  65    (lambda ()
  66     (handler-case
  67      (progn
  68       (setf (documentation 'unused 'function) ,doc)
  69       (sheep-func:doc->ast 'unused)
  70       nil)
  71      (sheep:validation-failure (vf)
  72       (let
  73        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
  74        (or
  75         (string= ,expected result)
  76         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
  77
  78 (defmacro deffailure-var-test (name doc expected)
  79  `(deftest
  80    ,(format nil "Var - ~A" name)
  81    (lambda ()
  82     (handler-case
  83      (progn
  84       (setf (documentation '*unused* 'variable) ,doc)
  85       (sheep-var:doc->ast '*unused*)
  86       nil)
  87      (sheep:validation-failure (vf)
  88       (let
  89        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
  90        (or
  91         (string= ,expected result)
  92         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
  93
  94 (defmacro deffailure-pkg-test (name doc expected)
  95  `(deftest
  96    ,(format nil "Package - ~A" name)
  97    (lambda ()
  98     (handler-case
  99      (progn
 100       (setf (documentation (find-package :sheep-unused) t) ,doc)
 101       (sheep-pkg:doc->ast (find-package :sheep-unused))
 102       nil)
 103      (sheep:validation-failure (vf)
 104       (let
 105        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
 106        (or
 107         (string= ,expected result)
 108         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
 109
 110 (defmacro deffailure-struc-test (name doc expected)
 111  `(deftest
 112    ,(format nil "Struct - ~A" name)
 113    (lambda ()
 114     (handler-case
 115      (progn
 116       (setf (documentation 'unused-struc 'structure) ,doc)
 117       (sheep-struc:doc->ast 'unused-struc)
 118       nil)
 119      (sheep:validation-failure (vf)
 120       (let
 121        ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
 122        (or
 123         (string= ,expected result)
 124         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
 125
 126 (defsuccesstest :success1 "resources/success1.lisp" "resources/success1.md")
 127 (deffailuretest :emptydocs "resources/emptydocs.lisp"
 128  `((:failure :emptydocs "Package EMPTYDOCS has no documentation")
 129    (:failure ,(intern "NO-DOC-CONDITION" :emptydocs) "Symbol NO-DOC-CONDITION has no documentation")
 130    (:failure ,(intern "NO-DOC-FUNC" :emptydocs) "Symbol NO-DOC-FUNC has no documentation")))