procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(loadhist-unload-element): Move ERT and cl-generic methods

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2017-07-24 15:58:30 -04:00
parent f07b12c1d0
commit 69fb12a66b
3 changed files with 24 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
lisp/emacs-lisp/cl-generic.el
View 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

13
lisp/emacs-lisp/ert.el
View 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

10
lisp/loadhist.el
View 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)))