branch: elpa/vm
commit e7a9e90795a6ee5d6e0c669cb9a07a1215f7e503
Author: Mark Diekhans <[email protected]>
Commit: Mark Diekhans <[email protected]>
Fix wrong-type-argument error in undo functions with intern records
vm-expunge-label creates undo records of the form (intern "label"
vm-label-obarray), which differ from the standard (function message
args...) format. The undo cleanup functions assumed all non-boundary
records had a message struct as their second element, causing
wrong-type-argument errors when calling vm-deleted-flag on a string.
Add vectorp checks in vm-clear-expunge-invalidated-undos,
vm-clear-virtual-quit-invalidated-undos, and vm-undo-set-message-pointer
to skip records that do not have a message struct.
---
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 ()
