doc/list-exports.lisp: Also scan `optparse.lisp'.

[sod] / doc / list-exports.lisp

diff --git a/doc/list-exports.lisp b/doc/list-exports.lisp
index 9f1382b..bcbf79f 100644 (file)
--- a/doc/list-exports.lisp
+++ b/doc/list-exports.lisp
@@ -123,6 +123,10 @@
     (when (or (specialized-on-p #'sod-parser:expand-parser-spec 1 symbol)
              (specialized-on-p #'sod-parser:expand-parser-form 1 symbol))
       (push :parser things))
+    (when (get symbol 'optparse::opthandler)
+      (push :opthandler things))
+    (when (get symbol 'optparse::optmacro)
+      (push :optmacro things))
     (nreverse things)))
 
 (defun categorize-symbols (paths package)
@@ -262,6 +266,36 @@
                                          obj))))))
                       (sb-mop:method-specializers method))))))))))
 
+(defun check-slot-names (package)
+  (setf package (find-package package))
+  (let* ((symbols (list-exported-symbols package))
+        (classes (mapcan (lambda (symbol)
+                           (when (eq (symbol-package symbol) package)
+                             (let ((class (find-class symbol nil)))
+                               (and class (list class)))))
+                         symbols))
+        (offenders (mapcan
+                    (lambda (class)
+                      (let* ((slot-names
+                              (mapcar #'sb-mop:slot-definition-name
+                                      (sb-mop:class-direct-slots class)))
+                             (exported (remove-if-not
+                                        (lambda (sym)
+                                          (or (and (symbol-package sym)
+                                                   (not (eq (symbol-package
+                                                             sym)
+                                                            package)))
+                                              (member sym symbols)))
+                                        slot-names)))
+                        (and exported
+                             (list (cons (class-name class)
+                                         exported)))))
+                           classes))
+        (bad-words (remove-duplicates (mapcan (lambda (list)
+                                                (copy-list (cdr list)))
+                                              offenders))))
+    (values offenders bad-words)))
+
 (defun report-symbols (paths package)
   (setf package (find-package package))
   (format t "~A~%Package `~(~A~)'~2%"
@@ -276,6 +310,17 @@
                  (pretty-symbol-name sym package)
                  (cdr def))))
       (terpri)))
+  (multiple-value-bind (alist names) (check-slot-names package)
+    (when names
+      (format t "Leaked slot names: ~{~A~^, ~}~%"
+             (mapcar (lambda (name) (pretty-symbol-name name package))
+                     names))
+      (dolist (assoc alist)
+       (format t "~2T~A: ~{~A~^, ~}~%"
+               (pretty-symbol-name (car assoc) package)
+               (mapcar (lambda (name) (pretty-symbol-name name package))
+                       (cdr assoc))))
+      (terpri)))
   (format t "Classes:~%")
   (analyse-classes package)
   (terpri)
@@ -299,7 +344,10 @@
   (let* ((sod (asdf:find-system "sod"))
         (parser-files (files (by-name sod "parser")))
         (utilities (by-name sod "utilities"))
-        (sod-files (remove utilities (files sod))))
+        (sod-frontend (asdf:find-system "sod-frontend"))
+        (optparse (by-name sod-frontend "optparse"))
+        (sod-files (set-difference (files sod) (list utilities))))
     (report-symbols (mapcar #'file-name sod-files) "SOD")
     (report-symbols (mapcar #'file-name parser-files) "SOD-PARSER")
+    (report-symbols (mapcar #'file-name (list optparse)) "OPTPARSE")
     (report-symbols (mapcar #'file-name (list utilities)) "SOD-UTILITIES"))))