branch: elpa/vm
commit 64bdc613196565776a47e181f89e88533132b023
Merge: ba6f0201d2 e7a9e90795
Author: Mark Diekhans <[email protected]>
Commit: Mark Diekhans <[email protected]>
Merge branch 'main' into 'main'
Fix wrong-type-argument error in undo functions with intern records
Closes #548
See merge request emacs-vm/vm!79
---
lisp/vm-undo.el | 9 +++++++++
test/vm-undo-test.el | 35 +++++++++++++++++++++++++++++++++++
2 files changed, 44 insertions(+)
diff --git a/lisp/vm-undo.el b/lisp/vm-undo.el
index f7b41d2ce2..14200e7ba4 100644
--- a/lisp/vm-undo.el
+++ b/lisp/vm-undo.el
@@ -53,6 +53,9 @@
(cond ((null (car udp))
(setq udp-prev udp))
((and (not (eq (car (car udp)) 'vm-set-buffer-modified-p))
+ ;; skip records that don't have a message struct
+ ;; (e.g., intern records from vm-expunge-label)
+ (vectorp (car (cdr (car udp))))
;; delete flag == expunged is the
;; indicator of an expunged message
(eq (vm-deleted-flag (car (cdr (car udp)))) 'expunged))
@@ -68,6 +71,9 @@
(cond ((null (car udp))
(setq udp-prev udp))
((and (not (eq (car (car udp)) 'vm-set-buffer-modified-p))
+ ;; skip records that don't have a message struct
+ ;; (e.g., intern records from vm-expunge-label)
+ (vectorp (car (cdr (car udp))))
;; message-id-number == "Q" is the
;; indicator of a dead message
(equal (vm-message-id-number-of (car (cdr (car udp)))) "Q"))
@@ -151,6 +157,9 @@
(defun vm-undo-set-message-pointer (record)
(if (and (not (eq (car record) 'vm-set-buffer-modified-p))
+ ;; skip records that don't have a message struct
+ ;; (e.g., intern records from vm-expunge-label)
+ (vectorp (nth 1 record))
(not (eq (nth 1 record) vm-message-pointer)))
(progn
(vm-record-and-change-message-pointer
diff --git a/test/vm-undo-test.el b/test/vm-undo-test.el
index 5d0a48d6e6..4604b80fe3 100644
--- a/test/vm-undo-test.el
+++ b/test/vm-undo-test.el
@@ -230,6 +230,41 @@ Body
;; Label should be back in obarray
(should (intern-soft "undo-test" vm-label-obarray))))
+;;; Test for clear-expunge handling of non-message records (bug fix)
+
+(ert-deftest vm-undo-test-clear-expunge-handles-intern-records ()
+ "Test that vm-clear-expunge-invalidated-undos handles intern records.
+This tests the fix for a bug where intern records from vm-expunge-label
+caused wrong-type-argument errors because the function assumed all
+non-boundary records had message structs."
+ (let ((vm-undo-record-list
+ (list nil
+ '(intern "some-label" vm-label-obarray) ; non-message record
+ nil)))
+ ;; Should not error
+ (vm-clear-expunge-invalidated-undos)
+ ;; The intern record should still be there (not removed)
+ (should (member '(intern "some-label" vm-label-obarray)
+ vm-undo-record-list))))
+
+(ert-deftest vm-undo-test-clear-virtual-quit-handles-intern-records ()
+ "Test that vm-clear-virtual-quit-invalidated-undos handles intern records."
+ (let ((vm-undo-record-list
+ (list nil
+ '(intern "some-label" vm-label-obarray) ; non-message record
+ nil)))
+ ;; Should not error
+ (vm-clear-virtual-quit-invalidated-undos)
+ ;; The intern record should still be there (not removed)
+ (should (member '(intern "some-label" vm-label-obarray)
+ vm-undo-record-list))))
+
+(ert-deftest vm-undo-test-set-message-pointer-handles-intern-records ()
+ "Test that vm-undo-set-message-pointer handles intern records."
+ (let ((vm-message-pointer nil))
+ ;; Should not error when called with an intern record
+ (vm-undo-set-message-pointer '(intern "some-label" vm-label-obarray))))
+
;;; Flag setting functions tests
(ert-deftest vm-undo-test-flag-functions-exist ()
