[Emacs-diffs] master f07b12c: Fix Bug#27371

[Michael Albinus]

branch: master
commit f07b12c1d036e50daa25b3a18b13686be6628c4d
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Fix Bug#27371
    
    * 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.
---
 lisp/loadhist.el             | 99 ++++++++++++++++++++++++++++----------------
 test/lisp/net/tramp-tests.el |  8 ++++
 2 files changed, 72 insertions(+), 35 deletions(-)

diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 28d0b18..693050d 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -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.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 94e91b7..bb1bafa 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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