Major effort to plug slot-name leaks.

[sod] / doc / list-exports.lisp

diff --git a/doc/list-exports.lisp b/doc/list-exports.lisp
index 9f1382b4a587b79c6d55cab2b33e53109712a505..abbf94aa14b1a9862ee3a088857104ea1d29b6f9 100644 (file)
--- a/doc/list-exports.lisp
+++ b/doc/list-exports.lisp
@@ -262,6 +262,36 @@ (defun analyse-generic-functions (package)
                                          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 +306,17 @@ (defun report-symbols (paths package)
                  (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)