]> git.eshelyaron.com Git - emacs.git/commitdiff
(loadhist-unload-element): Move ERT and cl-generic methods
authorStefan Monnier <monnier@iro.umontreal.ca>
Mon, 24 Jul 2017 19:58:30 +0000 (15:58 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Mon, 24 Jul 2017 19:58:30 +0000 (15:58 -0400)
* 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
lisp/emacs-lisp/ert.el
lisp/loadhist.el

index c64376b940f703f6a13811357ab9b7cde9845386..6a4ee47ac24a7de4dbb00ae609390cb4f6f784af 100644 (file)
@@ -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
index cee225cc8e09b596d16888efd6c39c9744bdd8fb..5c88b070f65a5a2f79e2a566bffb60c07941e5ad 100644 (file)
@@ -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
index 693050d70441d4db266283f98dc3aadb53f29085..24c3acd1b99f861401742fabe498845c71a1dfdd 100644 (file)
@@ -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)))