Add holistic checking

diff --git a/resources/emptydocs.lisp b/resources/emptydocs.lisp
new file mode 100644 (file)
index 0000000..7076c6a
--- /dev/null
+++ b/resources/emptydocs.lisp
@@ -0,0 +1,6 @@
+(defpackage #:emptydocs (:use :cl)
+ (:export #:no-doc-func))
+
+(in-package #:emptydocs)
+
+(defun no-doc-func (path x) path)

diff --git a/src/main/docgen.lisp b/src/main/docgen.lisp
index bb1b7a9af5db6b5eeec33ac7e22971eb7c06a22c..48d237121c5d62c2fa8bd0f939d93de3fff09850 100644 (file)
--- a/src/main/docgen.lisp
+++ b/src/main/docgen.lisp
@@ -2,23 +2,45 @@
 
 (define-condition validation-failure nil ((msg :initarg :msg :reader validation-failure-msg)))
 
 
 (define-condition validation-failure nil ((msg :initarg :msg :reader validation-failure-msg)))
 

+(defun get-symb-type (symb)
+ (cond
+  ;((documentation symb 'variable) :variable)
+  ;((documentation symb 'structure) :structure)
+  ((documentation symb 'function) :function)))
+

 (defun validate-package (pkg)
  (macrolet
   ((with-success-check (&rest f)
     `(handler-case
       (progn ,@f :success)
 (defun validate-package (pkg)
  (macrolet
   ((with-success-check (&rest f)
     `(handler-case
       (progn ,@f :success)

-      (validation-failure (v) (list :failure :msg (validation-failure-msg v))))))
+      (validation-failure (v) (list :failure (validation-failure-msg v))))))

   (let
    ((symbs nil))
    (do-external-symbols (symb pkg) (push symb symbs))
    (setf symbs (sort symbs #'string< :key #'symbol-name))
    (remove :success
     (append
   (let
    ((symbs nil))
    (do-external-symbols (symb pkg) (push symb symbs))
    (setf symbs (sort symbs #'string< :key #'symbol-name))
    (remove :success
     (append

-     (list (with-success-check (docgen-pkg:doc->ast pkg)))
+     (list (with-success-check (docgen-pkg:doc->ast (find-package pkg))))

      (mapcar
      (mapcar

-      (lambda (symb) (with-success-check (docgen-func:doc->ast symb)))
+      (lambda (symb)
+       (with-success-check
+        (case (get-symb-type symb)
+         (:function (docgen-func:doc->ast symb))
+         (t (error (make-condition 'validation-failure :msg (format nil "Symbol ~A has no documentation" symb)))))))

       symbs))))))
 
       symbs))))))
 

+(defun pretty-print-validate-packages (&rest pkgs)
+ (mapcar
+  (lambda (pkg)
+   (let
+    ((failures (validate-package pkg)))
+    (mapcar
+     (lambda (failure)
+      (format t "In package ~A, documentation error found:~%  ~A" pkg (cadr failure)))
+     failures)
+    (not failures)))
+  pkgs))
+

 (defun export-package (pkg)
  (let
   ((symbs nil))
 (defun export-package (pkg)
  (let
   ((symbs nil))


@@ -26,4 +48,9 @@
   (setf symbs (sort symbs #'string< :key #'symbol-name))
   (with-output-to-string (str)
    (format str "~A~%~%" (docgen-pkg:ast->md (docgen-pkg:doc->ast (find-package pkg))))
   (setf symbs (sort symbs #'string< :key #'symbol-name))
   (with-output-to-string (str)
    (format str "~A~%~%" (docgen-pkg:ast->md (docgen-pkg:doc->ast (find-package pkg))))

-   (format str "~{~A~^~%~}" (mapcar (lambda (symb) (docgen-func:ast->md (docgen-func:doc->ast symb))) symbs)))))
+   (format str "~{~A~^~%~}"
+    (mapcar
+     (lambda (symb)
+      (case (get-symb-type symb)
+       (:function (docgen-func:ast->md (docgen-func:doc->ast symb)))))
+     symbs)))))

diff --git a/src/main/package.lisp b/src/main/package.lisp
index 3012351c0131fb2c702a06e941687b0719d57925..458060244f0b9902fa98a46aba3688ed60174a9c 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -1,5 +1,5 @@
 (defpackage #:docgen (:use :cl)
 (defpackage #:docgen (:use :cl)

- (:export #:validate-package #:export-package #:validation-failure))
+ (:export #:validate-package #:export-package #:validation-failure #:pretty-print-validate-packages))

 
 (defpackage #:docgen-func (:use :cl)
  (:export #:doc->ast #:ast->md))
 
 (defpackage #:docgen-func (:use :cl)
  (:export #:doc->ast #:ast->md))

diff --git a/src/main/pkg.lisp b/src/main/pkg.lisp
index 1ce94be4f6b15a10f440764420fb00c34a3a022c..df9848f8e4c85cac2db749a2b364111d781de6f8 100644 (file)
--- a/src/main/pkg.lisp
+++ b/src/main/pkg.lisp
@@ -3,6 +3,7 @@
 (defun fire-error (msg) (error (make-instance 'docgen:validation-failure :msg msg)))
 
 (defun doc->ast (pkg)
 (defun fire-error (msg) (error (make-instance 'docgen:validation-failure :msg msg)))
 
 (defun doc->ast (pkg)

+ (when (not (documentation pkg t)) (fire-error (format nil "Package ~A has no documentation" (package-name pkg))))

  (labels
   ((validate (strs)
     (mapcar
  (labels
   ((validate (strs)
     (mapcar

diff --git a/src/test/main.lisp b/src/test/main.lisp
index 270609760f7b101bc940a224c2f602f989af8115..1b796f5ddd55b887eaab736690875f8fd5f18389 100644 (file)
--- a/src/test/main.lisp
+++ b/src/test/main.lisp
@@ -16,7 +16,10 @@
  `(push
    (lambda ()
     (let
  `(push
    (lambda ()
     (let

-     ((success (funcall ,f)))
+     ((success
+       (handler-case
+        (funcall ,f)
+        (error (e) (format t "Got unexpected error in tests: ~A" e)))))

      (if success
       (format t "~c[1;32m- ~A passed~c[0m~%" #\Esc ,name #\Esc)
       (format t "~c[1;31m- ~A failed~c[0m~%" #\Esc ,name #\Esc))
      (if success
       (format t "~c[1;32m- ~A passed~c[0m~%" #\Esc ,name #\Esc)
       (format t "~c[1;31m- ~A failed~c[0m~%" #\Esc ,name #\Esc))


@@ -32,9 +35,20 @@
       (load ,source)
       (string= (slurp-file ,target) (docgen:export-package ,pkg)))
      (docgen:validation-failure (vf)
       (load ,source)
       (string= (slurp-file ,target) (docgen:export-package ,pkg)))
      (docgen:validation-failure (vf)

-      (format t "Error gotten: ~A~%"
-       (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))
-     (error (e) (format t "Error gotten: ~A~%" e))))))
+      (format t "Validation failure gotten: ~A~%"
+       (funcall (symbol-function (find-symbol "VALIDATION-FAILURE-MSG" :docgen)) vf)))))))
+
+(defmacro deffailuretest (pkg source expected)
+ `(deftest
+   ,source
+   (lambda ()
+    (progn
+     (load ,source)
+     (let
+      ((result (docgen:validate-package ,pkg)))
+      (or
+       (equal ,expected result)
+       (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected)))))))

 
 (defmacro deffailure-func-test (name doc expected)
  `(deftest
 
 (defmacro deffailure-func-test (name doc expected)
  `(deftest


@@ -55,3 +69,6 @@
         (format t "  Got error:~%~S~%  but expected~%~S~%" result ,expected))))))))
 
 (defsuccesstest :success1 "resources/success1.lisp" "resources/success1.md")
         (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-FUNC has no documentation")))