From: Gerd Möllmann Date: Mon, 24 Oct 2022 08:59:13 +0000 (+0200) Subject: Prepare for testing find-symbol X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a2f9aa8e56eb7c0a3a9cba04afede3d5fad5330b;p=emacs.git Prepare for testing find-symbol * src/pkg.c (pkg_find_symbol1): Remove. (pkg_find_symbol): Lookup symbols differently. * lisp/emacs-lisp/pkg.el: Prepare for find-symbol tests. * test/src/pkg-tests.el (pkg-tests-use-package): New. --- diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el index 5e565228963..f5d067727a3 100644 --- a/lisp/emacs-lisp/pkg.el +++ b/lisp/emacs-lisp/pkg.el @@ -120,6 +120,14 @@ NAMES must be a list of package objects or valid package names." (mapcar #'(lambda (name) (pkg--find-or-make-package name)) names)) +(defun pkg--listify-packages (packages) + "Return a list of packages for PACKAGES. +If PACKAGES is not a list, make it a list. Then, find or make +packages for packages named in the list and return the result." + (let ((packages (if (listp packages) packages (list packages)))) + (cl-remove-duplicates (mapcar #'pkg--find-or-make-package + packages)))) + (defun pkg--package-or-lose (name) "Return the package denoted by NAME. If NAME is a package, return that. @@ -384,8 +392,7 @@ Value is the renamed package object." (defun import (symbols &optional package) (let ((package (pkg--package-or-default package)) (symbols (pkg--symbol-listify symbols))) - (list package symbols) - (error "not yet implemented"))) + (list package symbols))) ;;;###autoload (defun shadow (_symbols &optional package) @@ -398,15 +405,22 @@ Value is the renamed package object." (error "not yet implemented")) ;;;###autoload -(defun use-package (_use package) - (setq package (pkg--package-or-default package)) - (cl-pushnew (package-%use-list package) package)) +(defun use-package (use &optional package) + (let* ((package (pkg--package-or-default package)) + (use (pkg--listify-packages use))) + (setf (package-%use-list package) + (cl-union (package-%use-list package) + use)) + t)) ;;;###autoload -(defun unuse-package (_unuse package) - (setq package (pkg--package-or-default package)) - (setf (package-%use-list package) - (delq package (package-%use-list package)))) +(defun unuse-package (unuse &optional package) + (let* ((package (pkg--package-or-default package)) + (unuse (pkg--listify-packages unuse))) + (setf (package-%use-list package) + (cl-intersection (package-%use-list package) + unuse)) + t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; defpackage diff --git a/src/pkg.c b/src/pkg.c index 97bf0ea7f37..9515d37e6a9 100644 --- a/src/pkg.c +++ b/src/pkg.c @@ -221,18 +221,16 @@ pkg_package_or_default (Lisp_Object designator) ***********************************************************************/ /* Find a symbol with name NAME in PACKAGE or one of the packages it - inherits from. Value is Qunbound if no symbol is found. SEEN is a - list of packages that have already been checked, to prevent infinte - recursion. If STATUS is not null, return in it the status of the - symbol, one of :internal, :external, :inhertied. */ + inherits from (use-package). Value is the symbol found, or + Qunbound if no symbol is found. If STATUS is not null, return in + it the status of the symbol, one of :internal, :external, + :inhertied. */ -static Lisp_Object -pkg_find_symbol1 (Lisp_Object name, Lisp_Object package, Lisp_Object seen, - Lisp_Object *status) +Lisp_Object +pkg_find_symbol (Lisp_Object name, Lisp_Object package, Lisp_Object *status) { eassert (STRINGP (name)); eassert (PACKAGEP (package)); - eassert (CONSP (seen) || NILP (seen)); Lisp_Object symbol = Qunbound; if (status) @@ -240,7 +238,7 @@ pkg_find_symbol1 (Lisp_Object name, Lisp_Object package, Lisp_Object seen, const struct Lisp_Package *pkg = XPACKAGE (package); struct Lisp_Hash_Table *h = XHASH_TABLE (PACKAGE_SYMBOLS (package)); - ptrdiff_t i = hash_lookup (h, name, NULL); + const ptrdiff_t i = hash_lookup (h, name, NULL); if (i >= 0) { symbol = HASH_KEY (h, i); @@ -249,18 +247,17 @@ pkg_find_symbol1 (Lisp_Object name, Lisp_Object package, Lisp_Object seen, } else { - if (status) - *status = QCinherited; Lisp_Object tail = pkg->use_list; FOR_EACH_TAIL (tail) { const Lisp_Object used_package = XCAR (tail); - if (NILP (Fmemq (used_package, seen))) + struct Lisp_Hash_Table *h = XHASH_TABLE (PACKAGE_SYMBOLS (used_package)); + const ptrdiff_t i = hash_lookup (h, name, NULL); + if (i >= 0 && EQ (HASH_VALUE (h, i), QCexternal)) { - seen = Fcons (used_package, seen); - symbol = pkg_find_symbol1 (name, used_package, seen, NULL); - if (!EQ (symbol, Qunbound)) - return symbol; + if (status) + *status = QCinherited; + return HASH_KEY (h, i); } } } @@ -268,17 +265,6 @@ pkg_find_symbol1 (Lisp_Object name, Lisp_Object package, Lisp_Object seen, return symbol; } -/* Find a symbol with name NAME in PACKAGE or one of the packages it - inherits from. Value is Qunbound if no symbol is found. If STATUS - is not null, return in it the status of the symbol, one of - :internal, :external, :inhertied. */ - -Lisp_Object -pkg_find_symbol (Lisp_Object name, Lisp_Object package, Lisp_Object *status) -{ - return pkg_find_symbol1 (name, package, Qnil, status); -} - /* Add SYMBOL to package PACKAGE. Value is SYMBOL. The symbol gets status STATUS in PACKAGE (one of :external or :internal). */ diff --git a/test/src/pkg-tests.el b/test/src/pkg-tests.el index f769f8943ec..d2c8557b3b4 100644 --- a/test/src/pkg-tests.el +++ b/test/src/pkg-tests.el @@ -149,6 +149,11 @@ (should (delete-package x)) (should-error (rename-package x 'd)))) +(ert-deftest pkg-tests-use-package () + (with-packages (x y) + (let ((ax (intern "a" x))) + (use-package x y)))) + ;; (ert-deftest pkg-tests-find-symbol () ;; (should nil))