feature/pkg 72279265b0: More work on Lisp and tests

[Gerd Moellmann]

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

    More work on Lisp and tests
---
 lisp/emacs-lisp/pkg.el | 74 +++++++++++++++++++++++++++++++++++++++++---------
 test/src/pkg-tests.el  | 68 ++++++++++++++++++++++------------------------
 2 files changed, 94 insertions(+), 48 deletions(-)

diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el
index 4258673d9f..5e56522896 100644
--- a/lisp/emacs-lisp/pkg.el
+++ b/lisp/emacs-lisp/pkg.el
@@ -120,7 +120,10 @@ NAMES must be a list of package objects or valid package 
names."
   (mapcar #'(lambda (name) (pkg--find-or-make-package name))
           names))
 
-(defun pkg-package-or-lose (name)
+(defun pkg--package-or-lose (name)
+  "Return the package denoted by NAME.
+If NAME is a package, return that.
+Otherwise, NAME must be the name of a registered package."
   (if (packagep name)
       name
     (let ((pkg-name (pkg--stringify-name name "package")))
@@ -147,9 +150,13 @@ NAMES must be a list of package objects or valid package 
names."
         (package-%nicknames package)))
 
 (defun pkg--package-or-default (package)
+  "Return the package object denoted by PACKAGE.
+If PACKAGE is a package object, return that.
+If PACKAGE is nil, return the current package.
+Otherwise assume that "
   (cond ((packagep package) package)
         ((null package) *package*)
-        (t (pkg-package-or-lose package))))
+        (t (pkg--package-or-lose package))))
 
 (defun pkg--symbol-listify (thing)
   (cond ((listp thing)
@@ -161,6 +168,7 @@ NAMES must be a list of package objects or valid package 
names."
          (list thing))
        (t
         (error "%s is neither a symbol nor a list of symbols" thing))))
+
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                        Basic stuff
@@ -212,23 +220,29 @@ but is what Common Lisp implementations usually do."
 
 ;;;###autoload
 (defun package-name (package)
-  (package-%name (pkg-package-or-lose package)))
+  "Return the name of PACKAGE.
+If PACKAGE is not a package object already, it must the name of a
+registered package."
+  (package-%name (pkg--package-or-lose package)))
 
 ;;;###autoload
 (defun package-nicknames (package)
-  (package-%nicknames (pkg-package-or-lose package)))
+  "Return the list of nickname strings of PACKAGE.
+If PACKAGE is not a package object already, it must the name of a
+registered package."
+  (package-%nicknames (pkg--package-or-lose package)))
 
 ;;;###autoload
 (defun package-shadowing-symbols (package)
-  (package-%shadowing-symbols (pkg-package-or-lose package)))
+  (package-%shadowing-symbols (pkg--package-or-lose package)))
 
 ;;;###autoload
 (defun package-use-list (package)
-  (package-%use-list (pkg-package-or-lose package)))
+  (package-%use-list (pkg--package-or-lose package)))
 
 ;;;###autoload
 (defun package-used-by-list (package)
-  (let ((package (pkg-package-or-lose package))
+  (let ((package (pkg--package-or-lose package))
         ((used-by ())))
     (dolist (p (list-all-packages))
       (when (memq package (package-%use-list p))
@@ -237,6 +251,14 @@ but is what Common Lisp implementations usually do."
 
 ;;;###autoload
 (defun find-package (package)
+  "Find and return the package for PACKAGE.
+If PACKAGE is a package object, return that.
+
+Otherwise, PACKAGE must be a package name, and that name
+is lookup up in the package registry and the result is
+returned if found.
+
+Value is nil if no package with the given name is found. "
   (if (packagep package)
       package
     (let ((name (pkg--stringify-name package "package name")))
@@ -244,27 +266,51 @@ but is what Common Lisp implementations usually do."
 
 ;;;###autoload
 (defun delete-package (package)
+  "Delete PACKAGE.
+
+If PACKAGE is an already deleted package, return nil.
+
+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.
+
+An attempt to delete one of the standard packages results in an
+error."
   (if (and (packagep package)
            (null (package-%name package)))
       nil
-    (let ((package (pkg-package-or-lose package)))
+    (let ((package (pkg--package-or-lose package)))
       (when (or (eq package *emacs-package*)
                 (eq package *keyword-package*))
-        (error "Cannot delete standard package"))
+        (error "Cannot delete a standard package"))
       (pkg--remove-from-registry package)
       (setf (package-%name package) nil)
       t)))
 
 ;;;###autoload
 (defun rename-package (package new-name &optional new-nicknames)
-  (let ((package (pkg-package-or-lose package)))
+  "Replace name and nicknames of PACKAGE with NEW-NAME and NEW-NICKNAMES.
+
+PACKAGE must be a package object, or name a registered package.
+Deleted packages cannot be renamed.
+
+NEW-NAME must be a valid package name, a string, symbol, or
+character.
+
+Optional NEW-NICKSNAMES must be a list of valid package names.
+
+Value is the renamed package object."
+  (let ((package (pkg--package-or-lose package))
+        (new-name (pkg--stringify-name new-name "package name"))
+        (new-nicknames (pkg--stringify-names new-nicknames
+                                             "package nickname")))
     (unless (package-%name package)
-      ;; That's what CLHS says, and SBCL does...
-      (error "Cannot rename deleted package"))
+      (error "Package %s is deleted"))
     (pkg--remove-from-registry package)
     (setf (package-%nicknames package) new-nicknames)
     (setf (package-%name package) new-name)
-    (pkg--add-to-registry package)))
+    (pkg--add-to-registry package)
+    package))
 
 
 ;;; Here...
@@ -529,4 +575,6 @@ but is what Common Lisp implementations usually do."
 ;;                    ',shadows ',shadowing-imports ',(if use-p use :default)
 ;;                    ',imports ',interns ',exports ',doc))))
 
+(provide 'pkg)
+
 ;;; pkg.el ends here
diff --git a/test/src/pkg-tests.el b/test/src/pkg-tests.el
index add6770d40..f769f8943e 100644
--- a/test/src/pkg-tests.el
+++ b/test/src/pkg-tests.el
@@ -48,6 +48,8 @@
 
 (ert-deftest pkg-tests-standard-packages ()
   (should (packagep (find-package "emacs")))
+  (should (packagep (find-package 'emacs)))
+  (should (packagep (find-package :emacs)))
   (should (packagep (find-package "keyword")))
   (should (packagep (find-package "")))
   (should (eq (find-package "keyword") (find-package ""))))
@@ -86,6 +88,21 @@
     ;; Duplicates removed, order-preserving.
     (should (equal (package-nicknames x) '("y" "z")))))
 
+(ert-deftest pkg-tests-package-name ()
+  (should (equal (package-name (make-package "x")) "x"))
+  (should (equal (package-name (make-package :x)) "x"))
+  (should (equal (package-name "emacs") "emacs"))
+  (let ((p (make-package "x")))
+    (delete-package p)
+    (should (null (package-name p))))
+  (should-error (package-name 1)))
+
+(ert-deftest pkg-tests-package-nicknames ()
+  (let ((nicknames '(("a" "b") (?a :b))))
+    (dolist (n nicknames)
+      (let ((p (make-package "x" :nicknames n)))
+        (should (equal (package-nicknames p) '("a" "b")))))))
+
 (ert-deftest pkg-tests-list-all-packages ()
   (let ((all (list-all-packages)))
     (should (cl-every #'packagep all))
@@ -93,17 +110,10 @@
     (should (memq (find-package "keyword") all))
     (should (memq (find-package "") all))))
 
-;; (ert-deftest pkg-tests-package-use-list ()
-;;   (should nil))
-
-;; (ert-deftest pkg-tests-package-used-by-list ()
-;;   (should nil))
-
-;; (ert-deftest pkg-tests-package-shadowing-symbols ()
-;;   (should nil))
-
 (ert-deftest pkg-tests-package-find-package ()
   (with-packages (x)
+    ;; If called with a package, returns that package.
+    (should (eq (find-package x) x))
     (package-%register x)
     (should-error (find-package 1.0))
     (should (eq (find-package 'x) x))
@@ -124,32 +134,20 @@
     (should (null (package-name x)))
     (should (not (find-package 'x)))))
 
-;;   (with-packages (x)
-;;     (package-%register x)
-;;     (should (delete-package "x"))
-;;     (should-error (delete-package "x")))
-;;   (let ((original (list-all-packages)))
-;;     (with-packages ((x :nicknames '(y)))
-;;       (should (delete-package x))
-;;       (should (null (delete-package x)))
-;;       (should (not (find-package 'x)))
-;;       (should (not (find-package 'y))))))
-
-;; (ert-deftest pkg-tests-rename-package ()
-;;   (with-packages (x y)
-;;     (should (eq x (rename-package x 'a '(b))))
-;;     (should (not (find-package 'x)))
-;;     (should (eq (find-package 'a) x))
-;;     (should (eq (find-package 'b) x))
-;;     ;; Can't rename to an existing name or nickname.
-;;     (should-error (rename-package y 'a))
-;;     (should-error (rename-package y 'c :nicknames '("b")))
-;;     ;; Original package name and nicknames are unchanged.
-;;     (should (equal (package-name x) "a"))
-;;     (should (equal (package-nicknames x) '("b")))
-;;     ;; Can't rename deleted package.
-;;     (should (delete-package x))
-;;     (should-error (rename-package x 'd))))
+(ert-deftest pkg-tests-rename-package ()
+  (with-packages (x y)
+    (package-%register x)
+    (should (find-package 'x))
+    (should (eq x (rename-package x 'a '(b))))
+    (should (not (find-package 'x)))
+    (should (eq (find-package 'a) x))
+    (should (eq (find-package 'b) x))
+    ;; Can't rename to an existing name or nickname.
+    (should-error (rename-package y 'a))
+    (should-error (rename-package y 'c :nicknames '("b")))
+    ;; Can't rename deleted package.
+    (should (delete-package x))
+    (should-error (rename-package x 'd))))
 
 ;; (ert-deftest pkg-tests-find-symbol ()
 ;;   (should nil))