[Emacs-diffs] master 69fb12a: (loadhist-unload-element): Move ERT and cl-generic methods

[Stefan Monnier]

branch: master
commit 69fb12a66b3d6b9bfb55d8bcd58bec2a8e7ca55b
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    (loadhist-unload-element): Move ERT and cl-generic methods
    
    * lisp/loadhist.el (loadhist-unload-element): Don't define cl-generic
    and ert methods here.
    (loadhist-unload-element) <(head define-type)>: Remove unused var `slots'.
    
    * lisp/emacs-lisp/cl-generic.el (loadhist-unload-element): Define
    unload method for cl-defmethod.
    (cl-generic-ensure-function): Remove redundant `defalias'.
    
    * lisp/emacs-lisp/ert.el (ert-set-test): Move the current-load-list
    setting here...
    (ert-deftest): ...from here.
    (loadhist-unload-element): Define unload method for ert-deftest.
---
 lisp/emacs-lisp/cl-generic.el | 16 ++++++++++++++--
 lisp/emacs-lisp/ert.el        | 13 +++++++------
 lisp/loadhist.el              | 10 +++-------
 3 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index c64376b..6a4ee47 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -182,8 +182,7 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value 
TAG
              origname))
     (if generic
         (cl-assert (eq name (cl--generic-name generic)))
-      (setf (cl--generic name) (setq generic (cl--generic-make name)))
-      (defalias name (cl--generic-make-function generic)))
+      (setf (cl--generic name) (setq generic (cl--generic-make name))))
     generic))
 
 ;;;###autoload
@@ -1210,5 +1209,18 @@ Used internally for the (major-mode MODE) context 
specializers."
                     (progn (cl-assert (null modes)) mode)
                   `(derived-mode ,mode . ,modes))))
 
+;;; Support for unloading.
+
+(cl-defmethod loadhist-unload-element ((x (head cl-defmethod)))
+  (pcase-let*
+      ((`(,name ,qualifiers . ,specializers) (cdr x))
+       (generic (cl-generic-ensure-function name 'noerror)))
+    (when generic
+      (let* ((mt (cl--generic-method-table generic))
+             (me (cl--generic-member-method specializers qualifiers mt)))
+        (when me
+          (setf (cl--generic-method-table generic) (delq (car me) mt)))))))
+
+
 (provide 'cl-generic)
 ;;; cl-generic.el ends here
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index cee225c..5c88b07 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -136,8 +136,15 @@ Emacs bug 6581 at URL 
`http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
     ;; ert-test objects.  It designates an anonymous test.
     (error "Attempt to define a test named nil"))
   (put symbol 'ert--test definition)
+  ;; Register in load-history, so `symbol-file' can find us, and so
+  ;; unload-feature can unload our tests.
+  (cl-pushnew `(ert-deftest . ,symbol) current-load-list :test #'equal)
   definition)
 
+(cl-defmethod loadhist-unload-element ((x (head ert-deftest)))
+  (let ((name (cdr x)))
+    (put name 'ert--test nil)))
+
 (defun ert-make-test-unbound (symbol)
   "Make SYMBOL name no test.  Return SYMBOL."
   (cl-remprop symbol 'ert--test)
@@ -214,12 +221,6 @@ description of valid values for RESULT-TYPE.
                         ,@(when tags-supplied-p
                             `(:tags ,tags))
                         :body (lambda () ,@body)))
-         ;; This hack allows `symbol-file' to associate `ert-deftest'
-         ;; forms with files, and therefore enables `find-function' to
-         ;; work with tests.  However, it leads to warnings in
-         ;; `unload-feature', which doesn't know how to undefine tests
-         ;; and has no mechanism for extension.
-         (push '(ert-deftest . ,name) current-load-list)
          ',name))))
 
 ;; We use these `put' forms in addition to the (declare (indent)) in
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 693050d..24c3acd 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -196,11 +196,8 @@ restore a previous autoload if possible.")
 (cl-defmethod loadhist-unload-element ((x (head autoload)))
   (loadhist--unload-function x))
 
-(cl-defmethod loadhist-unload-element ((x (head require))) nil)
-(cl-defmethod loadhist-unload-element ((x (head defface))) nil)
-;; The following two might require more actions.
-(cl-defmethod loadhist-unload-element ((x (head ert-deftest))) nil)
-(cl-defmethod loadhist-unload-element ((x (head cl-defmethod))) nil)
+(cl-defmethod loadhist-unload-element ((_ (head require))) nil)
+(cl-defmethod loadhist-unload-element ((_ (head defface))) nil)
 
 (cl-defmethod loadhist-unload-element ((x (head provide)))
   ;; Remove any feature names that this file provided.
@@ -220,8 +217,7 @@ restore a previous autoload if possible.")
     (makunbound x)))
 
 (cl-defmethod loadhist-unload-element ((x (head define-type)))
-  (let* ((name (cdr x))
-         (slots (mapcar 'car (cdr (cl-struct-slot-info name)))))
+  (let* ((name (cdr x)))
     ;; Remove the struct.
     (setf (cl--find-class name) nil)))