aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2017-07-24 15:58:30 -0400
committerStefan Monnier2017-07-24 15:58:30 -0400
commit69fb12a66b3d6b9bfb55d8bcd58bec2a8e7ca55b (patch)
tree7608f9b5cc190eee0670647712080937d4bae602
parentf07b12c1d036e50daa25b3a18b13686be6628c4d (diff)
downloademacs-69fb12a66b3d6b9bfb55d8bcd58bec2a8e7ca55b.tar.gz
emacs-69fb12a66b3d6b9bfb55d8bcd58bec2a8e7ca55b.zip
(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.
-rw-r--r--lisp/emacs-lisp/cl-generic.el16
-rw-r--r--lisp/emacs-lisp/ert.el13
-rw-r--r--lisp/loadhist.el10
3 files changed, 24 insertions, 15 deletions
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index c64376b940f..6a4ee47ac24 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
182 origname)) 182 origname))
183 (if generic 183 (if generic
184 (cl-assert (eq name (cl--generic-name generic))) 184 (cl-assert (eq name (cl--generic-name generic)))
185 (setf (cl--generic name) (setq generic (cl--generic-make name))) 185 (setf (cl--generic name) (setq generic (cl--generic-make name))))
186 (defalias name (cl--generic-make-function generic)))
187 generic)) 186 generic))
188 187
189;;;###autoload 188;;;###autoload
@@ -1210,5 +1209,18 @@ Used internally for the (major-mode MODE) context specializers."
1210 (progn (cl-assert (null modes)) mode) 1209 (progn (cl-assert (null modes)) mode)
1211 `(derived-mode ,mode . ,modes)))) 1210 `(derived-mode ,mode . ,modes))))
1212 1211
1212;;; Support for unloading.
1213
1214(cl-defmethod loadhist-unload-element ((x (head cl-defmethod)))
1215 (pcase-let*
1216 ((`(,name ,qualifiers . ,specializers) (cdr x))
1217 (generic (cl-generic-ensure-function name 'noerror)))
1218 (when generic
1219 (let* ((mt (cl--generic-method-table generic))
1220 (me (cl--generic-member-method specializers qualifiers mt)))
1221 (when me
1222 (setf (cl--generic-method-table generic) (delq (car me) mt)))))))
1223
1224
1213(provide 'cl-generic) 1225(provide 'cl-generic)
1214;;; cl-generic.el ends here 1226;;; cl-generic.el ends here
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index cee225cc8e0..5c88b070f65 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'."
136 ;; ert-test objects. It designates an anonymous test. 136 ;; ert-test objects. It designates an anonymous test.
137 (error "Attempt to define a test named nil")) 137 (error "Attempt to define a test named nil"))
138 (put symbol 'ert--test definition) 138 (put symbol 'ert--test definition)
139 ;; Register in load-history, so `symbol-file' can find us, and so
140 ;; unload-feature can unload our tests.
141 (cl-pushnew `(ert-deftest . ,symbol) current-load-list :test #'equal)
139 definition) 142 definition)
140 143
144(cl-defmethod loadhist-unload-element ((x (head ert-deftest)))
145 (let ((name (cdr x)))
146 (put name 'ert--test nil)))
147
141(defun ert-make-test-unbound (symbol) 148(defun ert-make-test-unbound (symbol)
142 "Make SYMBOL name no test. Return SYMBOL." 149 "Make SYMBOL name no test. Return SYMBOL."
143 (cl-remprop symbol 'ert--test) 150 (cl-remprop symbol 'ert--test)
@@ -214,12 +221,6 @@ description of valid values for RESULT-TYPE.
214 ,@(when tags-supplied-p 221 ,@(when tags-supplied-p
215 `(:tags ,tags)) 222 `(:tags ,tags))
216 :body (lambda () ,@body))) 223 :body (lambda () ,@body)))
217 ;; This hack allows `symbol-file' to associate `ert-deftest'
218 ;; forms with files, and therefore enables `find-function' to
219 ;; work with tests. However, it leads to warnings in
220 ;; `unload-feature', which doesn't know how to undefine tests
221 ;; and has no mechanism for extension.
222 (push '(ert-deftest . ,name) current-load-list)
223 ',name)))) 224 ',name))))
224 225
225;; We use these `put' forms in addition to the (declare (indent)) in 226;; We use these `put' forms in addition to the (declare (indent)) in
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 693050d7044..24c3acd1b99 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -196,11 +196,8 @@ restore a previous autoload if possible.")
196(cl-defmethod loadhist-unload-element ((x (head autoload))) 196(cl-defmethod loadhist-unload-element ((x (head autoload)))
197 (loadhist--unload-function x)) 197 (loadhist--unload-function x))
198 198
199(cl-defmethod loadhist-unload-element ((x (head require))) nil) 199(cl-defmethod loadhist-unload-element ((_ (head require))) nil)
200(cl-defmethod loadhist-unload-element ((x (head defface))) nil) 200(cl-defmethod loadhist-unload-element ((_ (head defface))) nil)
201;; The following two might require more actions.
202(cl-defmethod loadhist-unload-element ((x (head ert-deftest))) nil)
203(cl-defmethod loadhist-unload-element ((x (head cl-defmethod))) nil)
204 201
205(cl-defmethod loadhist-unload-element ((x (head provide))) 202(cl-defmethod loadhist-unload-element ((x (head provide)))
206 ;; Remove any feature names that this file provided. 203 ;; Remove any feature names that this file provided.
@@ -220,8 +217,7 @@ restore a previous autoload if possible.")
220 (makunbound x))) 217 (makunbound x)))
221 218
222(cl-defmethod loadhist-unload-element ((x (head define-type))) 219(cl-defmethod loadhist-unload-element ((x (head define-type)))
223 (let* ((name (cdr x)) 220 (let* ((name (cdr x)))
224 (slots (mapcar 'car (cdr (cl-struct-slot-info name)))))
225 ;; Remove the struct. 221 ;; Remove the struct.
226 (setf (cl--find-class name) nil))) 222 (setf (cl--find-class name) nil)))
227 223