feature/pkg a2f9aa8e56: Prepare for testing find-symbol

[Gerd Moellmann]

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

    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.
---
 lisp/emacs-lisp/pkg.el | 32 +++++++++++++++++++++++---------
 src/pkg.c              | 40 +++++++++++++---------------------------
 test/src/pkg-tests.el  |  5 +++++
 3 files changed, 41 insertions(+), 36 deletions(-)

diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el
index 5e56522896..f5d067727a 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 97bf0ea7f3..9515d37e6a 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 f769f8943e..d2c8557b3b 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))