andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix Bug#27371

Browse source 
* lisp/loadhist.el (loadhist-unload-element): Declare for
different entry types of `load-history'.
(loadhist--restore-autoload): New variable.
(loadhist--unload-function): New defun.
(unload-feature): Use `loadhist-unload-element'.  Recommended by
Stefan Monnier.  (Bug#27371)

* test/lisp/net/tramp-tests.el (tramp-test39-unload):
Check, that the `tramp-file-name' structure has been unloaded.
This commit is contained in:
Michael Albinus 2017-07-24 19:38:17 +02:00
parent fe25d0ce8e
commit f07b12c1d0
2 changed files with 72 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

99
lisp/loadhist.el
View file

@ -162,6 +162,69 @@ documentation of `unload-feature' for details.")
;; mode, or proposed is not nil and not major-mode, and so we use it.
(funcall (or proposed 'fundamental-mode)))))))
(cl-defgeneric loadhist-unload-element (x)
"Unload an element from the `load-history'."
(message "Unexpected element %S in load-history" x))
;; In `load-history', the definition of a previously autoloaded
;; function is represented by 2 entries: (t . SYMBOL) comes before
;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when
;; we undefine it.
;; So we use this auxiliary variable to keep track of the last (t . SYMBOL)
;; that occurred.
(defvar loadhist--restore-autoload
"If non-nil, this is a symbol for which we should
restore a previous autoload if possible.")
(cl-defmethod loadhist-unload-element ((x (head t)))
(setq loadhist--restore-autoload (cdr x)))
(defun loadhist--unload-function (x)
(let ((fun (cdr x)))
(when (fboundp fun)
(when (fboundp 'ad-unadvise)
(ad-unadvise fun))
(let ((aload (get fun 'autoload)))
(defalias fun
(if (and aload (eq fun loadhist--restore-autoload))
(cons 'autoload aload)
nil)))))
(setq loadhist--restore-autoload nil))
(cl-defmethod loadhist-unload-element ((x (head defun)))
(loadhist--unload-function x))
(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 ((x (head provide)))
;; Remove any feature names that this file provided.
(setq features (delq (cdr x) features)))
(cl-defmethod loadhist-unload-element ((x symbol))
;; Kill local values as much as possible.
(dolist (buf (buffer-list))
(with-current-buffer buf
(if (and (boundp x) (timerp (symbol-value x)))
(cancel-timer (symbol-value x)))
(kill-local-variable x)))
(if (and (boundp x) (timerp (symbol-value x)))
(cancel-timer (symbol-value x)))
;; Get rid of the default binding if we can.
(unless (local-variable-if-set-p x)
(makunbound x)))
(cl-defmethod loadhist-unload-element ((x (head define-type)))
(let* ((name (cdr x))
(slots (mapcar 'car (cdr (cl-struct-slot-info name)))))
;; Remove the struct.
(setf (cl--find-class name) nil)))
;;;###autoload
(defun unload-feature (feature &optional force)
"Unload the library that provided FEATURE.
@ -200,9 +263,6 @@ something strange, such as redefining an Emacs function."
(prin1-to-string dependents) file))))
(let* ((unload-function-defs-list (feature-symbols feature))
(file (pop unload-function-defs-list))
;; If non-nil, this is a symbol for which we should
;; restore a previous autoload if possible.
restore-autoload
(name (symbol-name feature))
(unload-hook (intern-soft (concat name "-unload-hook")))
(unload-func (intern-soft (concat name "-unload-function"))))
@ -250,38 +310,7 @@ something strange, such as redefining an Emacs function."
(when (symbolp elt)
(elp-restore-function elt))))
(dolist (x unload-function-defs-list)
(if (consp x)
(pcase (car x)
;; Remove any feature names that this file provided.
(`provide
(setq features (delq (cdr x) features)))
((or `defun `autoload)
(let ((fun (cdr x)))
(when (fboundp fun)
(when (fboundp 'ad-unadvise)
(ad-unadvise fun))
(let ((aload (get fun 'autoload)))
(if (and aload (eq fun restore-autoload))
(fset fun (cons 'autoload aload))
(fmakunbound fun))))))
;; (t . SYMBOL) comes before (defun . SYMBOL)
;; and says we should restore SYMBOL's autoload
;; when we undefine it.
(`t (setq restore-autoload (cdr x)))
((or `require `defface) nil)
(_ (message "Unexpected element %s in load-history" x)))
;; Kill local values as much as possible.
(dolist (buf (buffer-list))
(with-current-buffer buf
(if (and (boundp x) (timerp (symbol-value x)))
(cancel-timer (symbol-value x)))
(kill-local-variable x)))
(if (and (boundp x) (timerp (symbol-value x)))
(cancel-timer (symbol-value x)))
;; Get rid of the default binding if we can.
(unless (local-variable-if-set-p x)
(makunbound x))))
(mapc #'loadhist-unload-element unload-function-defs-list)
;; Delete the load-history element for this file.
(setq load-history (delq (assoc file load-history) load-history))))
;; Don't return load-history, it is not useful.

8
test/lisp/net/tramp-tests.el
View file

@ -3906,6 +3906,14 @@ Since it unloads Tramp, it shall be the last test to run."
(not (string-match "^tramp--?test" (symbol-name x)))
(not (string-match "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
;; The defstruct `tramp-file-name' and all its internal functions
;; shall be purged.
(should-not (cl--find-class 'tramp-file-name))
(mapatoms
(lambda (x)
(and (string-match "tramp-file-name" (symbol-name x))
(functionp x)
(ert-fail (format "Structure function `%s' still exists" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms