From 7a1eba3576f2b2983e9d1dbb2077bc953a597e7f Mon Sep 17 00:00:00 2001 From: =?utf8?q?Gerd=20M=C3=B6llmann?= Date: Tue, 25 Oct 2022 08:50:11 +0200 Subject: [PATCH] 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 38b412a8eb1..fd5eecd0445 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 b24e71427a1..c9127f16d91 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)) -- 2.39.2