feature/pkg 7a1eba3576 3/3: Reset symbol home packages

[Gerd Moellmann]

branch: feature/pkg
commit 7a1eba3576f2b2983e9d1dbb2077bc953a597e7f
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    Reset symbol home packages
    
    * lisp/emacs-lisp/pkg.el (delete-package): Set the package of
    symbols whose home package is the deleted package to nil.
    * test/src/pkg-tests.el (pkg-tests-delete-package):
    (pkg-tests-use-package): Modify because we don't have export yet.
---
 lisp/emacs-lisp/pkg.el | 156 ++++++++++++++++++++++++++-----------------------
 test/src/pkg-tests.el  |  22 ++++++-
 2 files changed, 101 insertions(+), 77 deletions(-)

diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el
index 38b412a8eb..fd5eecd044 100644
--- a/lisp/emacs-lisp/pkg.el
+++ b/lisp/emacs-lisp/pkg.el
@@ -179,11 +179,85 @@ Otherwise assume that "
 
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;                        Basic stuff
+;;                                  Macros
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;;###autoload
+(cl-defmacro do-symbols ((var &optional (package '*package*) result-form)
+                        &body body)
+  "Loop over symbols in a package.
+
+Evaluate BODY with VAR bound to each symbol accessible in the given
+PACKAGE, or the current package if PACKAGE is not specified.
+
+Return what RESULT-FORM evaluates to, if specified, and the loop ends
+normally, or else if an explcit return occurs the value it transfers."
+  (declare (indent 1))
+  (let ((flet-name (gensym "do-symbols-")))
+    `(cl-block nil
+       (cl-flet ((,flet-name (,var)
+                  (cl-tagbody ,@body)))
+        (let* ((package (pkg--package-or-lose ,package))
+               (shadows (package-%shadowing-symbols package)))
+          (maphash (lambda (k v) (,flet-name k))
+                   (package-%symbols package))
+          (dolist (p (package-%use-list package))
+            (maphash (lambda (k v)
+                       (when (eq v :external)
+                         (,flet-name k)))
+                     (package-%symbols p))
+       (let ((,var nil))
+        ,result-form)))))))
+
+;;;###autoload
+(cl-defmacro do-external-symbols ((var &optional (package '*package*) 
result-form)
+                                 &body body)
+  "Loop over external symbols in a package.
+
+Evaluate BODY with VAR bound to each symbol accessible in the given
+PACKAGE, or the current package if PACKAGE is not specified.
+
+Return what RESULT-FORM evaluates to, if specified, and the loop ends
+normally, or else if an explcit return occurs the value it transfers."
+  (let ((flet-name (gensym "do-symbols-")))
+    `(cl-block nil
+       (cl-flet ((,flet-name (,var)
+                  (cl-tagbody ,@body)))
+        (let* ((package (pkg--package-or-lose ,package))
+               (shadows (package-%shadowing-symbols package)))
+          (maphash (lambda (k v)
+                     (when (eq v :external)
+                       (,flet-name k)))
+                   (package-%symbols package))))
+       (let ((,var nil))
+        ,result-form))))
+
+;;;###autoload
+(cl-defmacro do-all-symbols ((var &optional result-form) &body body)
+  "Loop over all symbols in all registered packages.
+
+Evaluate BODY with VAR bound to each symbol accessible in the given
+PACKAGE, or the current package if PACKAGE is not specified.
+
+Return what RESULT-FORM evaluates to, if specified, and the loop ends
+normally, or else if an explcit return occurs the value it transfers."
+  (let ((flet-name (gensym "do-symbols-")))
+    `(cl-block nil
+       (cl-flet ((,flet-name (,var)
+                  (cl-tagbody ,@body)))
+         (dolist (package (list-all-packages))
+          (maphash (lambda (k _v)
+                     (,flet-name k))
+                   (package-%symbols package))))
+       (let ((,var nil))
+        ,result-form))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                        Basic stuff
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;;###autoload
 (cl-defun make-package (name &key nicknames use (size 10))
   "Create and return a new package with name NAME.
 
@@ -285,6 +359,10 @@ If PACKAGE is a package that is not already deleted, or 
PACKAGE
 is a package name that is registered, delete that package by
 removing it from the package registry, and return t.
 
+After this operation completes, the home package of any symbol
+whose home package had previously been package is set to nil.
+That is, these symbols are now considered uninterned symbols.
+
 An attempt to delete one of the standard packages results in an
 error."
   (if (and (packagep package)
@@ -296,6 +374,9 @@ error."
         (error "Cannot delete a standard package"))
       (pkg--remove-from-registry package)
       (setf (package-%name package) nil)
+      (do-symbols (sym package)
+        (when (eq (symbol-package sym) package)
+          (package-%set-symbol-package sym nil)))
       t)))
 
 ;;;###autoload
@@ -323,9 +404,6 @@ Value is the renamed package object."
     (pkg--add-to-registry package)
     package))
 
-
-;;; Here...
-
 ;;;###autoload
 (defun export (symbols &optional package)
   "tbd"
@@ -439,76 +517,6 @@ Value is the renamed package object."
                            unuse))
     t))
 
-;;;###autoload
-(cl-defmacro do-symbols ((var &optional (package '*package*) result-form)
-                        &body body)
-  "Loop over symbols in a package.
-
-Evaluate BODY with VAR bound to each symbol accessible in the given
-PACKAGE, or the current package if PACKAGE is not specified.
-
-Return what RESULT-FORM evaluates to, if specified, and the loop ends
-normally, or else if an explcit return occurs the value it transfers."
-  (declare (indent 1))
-  (let ((flet-name (gensym "do-symbols-")))
-    `(cl-block nil
-       (cl-flet ((,flet-name (,var)
-                  (cl-tagbody ,@body)))
-        (let* ((package (pkg--package-or-lose ,package))
-               (shadows (package-%shadowing-symbols package)))
-          (maphash (lambda (k v) (,flet-name k))
-                   (package-%symbols package))
-          (dolist (p (package-%use-list package))
-            (maphash (lambda (k v)
-                       (when (eq v :external)
-                         (,flet-name k)))
-                     (package-%symbols p))
-       (let ((,var nil))
-        ,result-form)))))))
-
-;;;###autoload
-(cl-defmacro do-external-symbols ((var &optional (package '*package*) 
result-form)
-                                 &body body)
-  "Loop over external symbols in a package.
-
-Evaluate BODY with VAR bound to each symbol accessible in the given
-PACKAGE, or the current package if PACKAGE is not specified.
-
-Return what RESULT-FORM evaluates to, if specified, and the loop ends
-normally, or else if an explcit return occurs the value it transfers."
-  (let ((flet-name (gensym "do-symbols-")))
-    `(cl-block nil
-       (cl-flet ((,flet-name (,var)
-                  (cl-tagbody ,@body)))
-        (let* ((package (pkg--package-or-lose ,package))
-               (shadows (package-%shadowing-symbols package)))
-          (maphash (lambda (k v)
-                     (when (eq v :external)
-                       (,flet-name k)))
-                   (package-%symbols package))))
-       (let ((,var nil))
-        ,result-form))))
-
-;;;###autoload
-(cl-defmacro do-all-symbols ((var &optional result-form) &body body)
-  "Loop over all symbols in all registered packages.
-
-Evaluate BODY with VAR bound to each symbol accessible in the given
-PACKAGE, or the current package if PACKAGE is not specified.
-
-Return what RESULT-FORM evaluates to, if specified, and the loop ends
-normally, or else if an explcit return occurs the value it transfers."
-  (let ((flet-name (gensym "do-symbols-")))
-    `(cl-block nil
-       (cl-flet ((,flet-name (,var)
-                  (cl-tagbody ,@body)))
-         (dolist (package (list-all-packages))
-          (maphash (lambda (k _v)
-                     (,flet-name k))
-                   (package-%symbols package))))
-       (let ((,var nil))
-        ,result-form))))
-
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                            defpackage
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/test/src/pkg-tests.el b/test/src/pkg-tests.el
index b24e71427a..c9127f16d9 100644
--- a/test/src/pkg-tests.el
+++ b/test/src/pkg-tests.el
@@ -132,7 +132,13 @@
     (should (delete-package x))
     (should (null (delete-package x)))
     (should (null (package-name x)))
-    (should (not (find-package 'x)))))
+    (should (not (find-package 'x))))
+  ;; Symbols whose home package is a package that is deleted, become
+  ;; uninterned.
+  (with-packages (x)
+    (let ((sym (intern "a" x)))
+      (delete-package x)
+      (should (null (symbol-package sym))))))
 
 (ert-deftest pkg-tests-rename-package ()
   (with-packages (x y)
@@ -151,8 +157,18 @@
 
 (ert-deftest pkg-tests-use-package ()
   (with-packages (x y)
-    (let ((_a (intern "a" x)))
-      (use-package x y))))
+    (let ((sym-a (intern "a" x)))
+      (should (eq (symbol-package sym-a) x))
+      (use-package x y)
+      (cl-multiple-value-bind (sym status)
+          (find-symbol "a" y)
+        (should (null sym))
+        (when nil
+          (export sym-a x)
+          (cl-multiple-value-bind (sym status)
+              (find-symbol "a" y)
+            (should (eq sym sym-a))
+            (should (eq status :inherited))))))))
 
 ;; (ert-deftest pkg-tests-find-symbol ()
 ;;   (should nil))