bug#27371: 26.0.50; Unexpected element (define-type . tramp-file-name) in load-history

[Michael Albinus <michael.albinus@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 579 bytes --]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

Hi Stefan,

>>> Then we can add support for define-type, ert-deftest, cl-defmethod, ...
>> That's my original question: what does it take to unload a `define-type'
>> entry?
>
> Presumably it should undo what cl-struct-define does.
> The main part would be (setf (cl--find-class name) nil), I guess.

I've ended up with the appended patch. Would this be OK? More precise,
would the implementation of

(cl-defmethod loadhist-unload-element ((x (head define-type)))

be the right thing?

>         Stefan

Best regards, Michael.


[-- Attachment #2: Type: text/plain, Size: 5462 bytes --]

diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 28d0b18c81..59b1688857 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -162,6 +162,83 @@ unload--set-major-mode
           ;; 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)
+    ;; Remove internal functions.
+    (dolist (fun
+	     (append
+	      ;; constructor, copier, predicate, tag-symbol.
+	      `(,(format "make-%s" name)
+	        ,(format "copy-%s" name)
+	        ,(format "%s-p" name)
+	        ,(format "cl-struct-%s-tags" name))
+	      ;; accessors.
+	      (mapcar #'(lambda (y) (format "%s-%s" name y)) slots)))
+      (dolist
+          (symbol
+           `(,fun ,(format "%s--cmacro" fun) ,(format "--cl-block-%s--" fun)))
+        (unintern symbol obarray)))))
+
 ;;;###autoload
 (defun unload-feature (feature &optional force)
   "Unload the library that provided FEATURE.
@@ -200,9 +277,6 @@ unload-feature
 	       (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 +324,7 @@ unload-feature
 	  (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.