doc/list-exports.lisp: Forbid bad slot names in private classes.

Previously we only worried about exported/foreign slot names in classes
whose names were exported symbols.  Also worry about classes whose names
are private symbols (in the home package).

diff --git a/doc/list-exports.lisp b/doc/list-exports.lisp
index bc40e958dc0d607a3ea165c2fe9f2ab770086fca..6663801eabf4d9dba7a3ab86397ad0b1e98d86ac 100755 (executable)
--- a/doc/list-exports.lisp
+++ b/doc/list-exports.lisp
@@ -116,6 +116,16 @@ (defun list-exported-symbols (package)
   (sort (loop for s being the external-symbols of package collect s)
        #'string< :key #'symbol-name))
 
   (sort (loop for s being the external-symbols of package collect s)
        #'string< :key #'symbol-name))
 

+(defun list-all-symbols (package)
+  (let ((externs (make-hash-table)))
+    (dolist (sym (list-exported-symbols package))
+      (setf (gethash sym externs) t))
+    (sort (loop for s being the symbols of package
+               when (or (not (exported-symbol-p s))
+                        (gethash s externs))
+                 collect s)
+         #'string< :key #'symbol-name)))
+

 (defun find-symbol-homes (paths package)
   (let* ((symbols (list-exported-symbols package))
         (exports-alist (let ((*package* package))
 (defun find-symbol-homes (paths package)
   (let* ((symbols (list-exported-symbols package))
         (exports-alist (let ((*package* package))


@@ -427,7 +437,7 @@ (defun analyse-generic-functions (package)
 
 (defun check-slot-names (package)
   (setf package (find-package package))
 
 (defun check-slot-names (package)
   (setf package (find-package package))

-  (let* ((symbols (list-exported-symbols package))
+  (let* ((symbols (list-all-symbols package))

         (classes (mapcan (lambda (symbol)
                            (when (eq (symbol-package symbol) package)
                              (let ((class (find-class symbol nil)))
         (classes (mapcan (lambda (symbol)
                            (when (eq (symbol-package symbol) package)
                              (let ((class (find-class symbol nil)))