diff options
| author | Stefan Monnier | 2017-07-24 15:58:30 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2017-07-24 15:58:30 -0400 |
| commit | 69fb12a66b3d6b9bfb55d8bcd58bec2a8e7ca55b (patch) | |
| tree | 7608f9b5cc190eee0670647712080937d4bae602 | |
| parent | f07b12c1d036e50daa25b3a18b13686be6628c4d (diff) | |
| download | emacs-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.el | 16 | ||||
| -rw-r--r-- | lisp/emacs-lisp/ert.el | 13 | ||||
| -rw-r--r-- | 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 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 | ||