Add coverage, get to near 100

[sheep] / src / test / main.lisp

diff --git a/src/test/main.lisp b/src/test/main.lisp
index a73dd7bac468278c8ede478c842736f19bdc24a6..4c5deded542901b9dfd567975039e542448608f1 100644 (file)
--- a/src/test/main.lisp
+++ b/src/test/main.lisp
@@ -1,6 +1,10 @@
-(in-package #:docgen-test)
+; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
+(in-package #:sheep-test)
 
-(defvar *tests* nil)
+(defparameter *tests* nil)
+
+; Used just for tests
+(defstruct unused-struc)
 
 ; This really is just here to check against regressions
 (defun run-all-tests ()
@@ -33,10 +37,11 @@
     (handler-case
      (progn
       (load ,source)
-      (string= (slurp-file ,target) (docgen:export-package ,pkg)))
-     (docgen:validation-failure (vf)
+      (sheep:pretty-print-validate-packages ,pkg)
+      (string= (slurp-file ,target) (sheep:export-package ,pkg)))
+     (sheep:validation-failure (vf)
       (format t "Validation failure gotten: ~A~%"
-       (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))))))
+       (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))))))
 
 (defmacro deffailuretest (pkg source expected)
  `(deftest
@@ -45,31 +50,81 @@
     (progn
      (load ,source)
      (let
-      ((result (docgen:validate-package ,pkg)))
+      ((result (sheep:validate-package ,pkg)))
+      (let
+       ((*error-output* (make-broadcast-stream))
+        (*standard-output* (make-broadcast-stream)))
+       (sheep:pretty-print-validate-packages ,pkg))
       (or
        (equal ,expected result)
        (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected)))))))
 
 (defmacro deffailure-func-test (name doc expected)
  `(deftest
-   ,name
+   ,(format nil "Func - ~A" name)
+   (lambda ()
+    (handler-case
+     (progn
+      (setf (documentation 'unused 'function) ,doc)
+      (sheep-func:doc->ast 'unused)
+      nil)
+     (sheep:validation-failure (vf)
+      (let
+       ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
+       (or
+        (string= ,expected result)
+        (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
+
+(defmacro deffailure-var-test (name doc expected)
+ `(deftest
+   ,(format nil "Var - ~A" name)
+   (lambda ()
+    (handler-case
+     (progn
+      (setf (documentation '*unused* 'variable) ,doc)
+      (sheep-var:doc->ast '*unused*)
+      nil)
+     (sheep:validation-failure (vf)
+      (let
+       ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
+       (or
+        (string= ,expected result)
+        (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
+
+(defmacro deffailure-pkg-test (name doc expected)
+ `(deftest
+   ,(format nil "Package - ~A" name)
+   (lambda ()
+    (handler-case
+     (progn
+      (setf (documentation (find-package :sheep-unused) t) ,doc)
+      (sheep-pkg:doc->ast (find-package :sheep-unused))
+      nil)
+     (sheep:validation-failure (vf)
+      (let
+       ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
+       (or
+        (string= ,expected result)
+        (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
+
+(defmacro deffailure-struc-test (name doc expected)
+ `(deftest
+   ,(format nil "Struct - ~A" name)
    (lambda ()
     (handler-case
      (progn
-      (funcall
-       (symbol-function (find-symbol "INTERNAL-DOC->AST" :docgen-func))
-       'unused
-       ,doc)
+      (setf (documentation 'unused-struc 'structure) ,doc)
+      (sheep-struc:doc->ast 'unused-struc)
       nil)
-     (docgen:validation-failure (vf)
+     (sheep:validation-failure (vf)
       (let
-       ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))
+       ((result (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :sheep)) vf)))
        (or
         (string= ,expected result)
         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
 
 (defsuccesstest :success1 "resources/success1.lisp" "resources/success1.md")
 (deffailuretest :emptydocs "resources/emptydocs.lisp"
- '((:failure "Package EMPTYDOCS has no documentation")
-   (:failure "Symbol NO-DOC-CONDITION has no documentation")
-   (:failure "Symbol NO-DOC-FUNC has no documentation")))
+ `((:failure :emptydocs "Package EMPTYDOCS has no documentation")
+   (:failure ,(intern "NO-DOC-CONDITION" :emptydocs) "Symbol NO-DOC-CONDITION has no documentation")
+   (:failure ,(intern "NO-DOC-FUNC" :emptydocs) "Symbol NO-DOC-FUNC has no documentation")))