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
(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
;; 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)
,@(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
(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.
(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)))