Subject: bug#63513: [PATCH] Make persist-defvar work with records and hash tables

From: Joseph Turner <[email-masked]>
Date: Mon, 04 Sep 2023 15:28:15 -0700

Stefan Monnier <[email-masked]> writes:
> I was about to ping Phil over on https://gitlab.com/phillord/persist/
> but was reminded along the way that Phil gave me write access to
> that repository.
>
> Could you send me the result of your final editing pass?

Here you go!

>From 2ca778a44c10f11059f16ef5922cf1eff9118105 Mon Sep 17 00:00:00 2001
From: Joseph Turner <[email-masked]>
Date: Tue, 23 May 2023 12:57:02 -0700
Subject: [PATCH 1/5] Add test-persist-save macro

* test/persist-tests.el (persist-test-persist-save):
Consolidate logic of test-persist-save and
test-persist-save-non-number.
(test-persist-save-number test-persist-save-string): Simple wrappers
over persist-test-persist-save
---
 test/persist-tests.el | 76 +++++++++++++++++++------------------------
 1 file changed, 33 insertions(+), 43 deletions(-)

diff --git a/test/persist-tests.el b/test/persist-tests.el
index b6645a9297..f2b04769ef 100644
--- a/test/persist-tests.el
+++ b/test/persist-tests.el
@@ -25,51 +25,41 @@ (ert-deftest test-persist-save-only-persistant ()
    :type 'error
    :exclude-subtypes t))
 
-(ert-deftest test-persist-save ()
-  (with-local-temp-persist
-   (let ((sym (cl-gensym)))
-     ;; precondition
-   (should-not (file-exists-p (persist--file-location sym)))
-     (set sym 10)
-     (persist-symbol sym 10)
-     (persist-save sym)
-     (should t)
-     (should-not (file-exists-p (persist--file-location sym)))
-     (set sym 20)
-     (persist-save sym)
-     (should (file-exists-p (persist--file-location sym)))
-     (should
-      (string-match-p
-       "20"
-       (with-temp-buffer
-         (insert-file-contents (persist--file-location sym))
-         (buffer-string))))
-     (set sym 10)
-     (persist-save sym)
-     (should-not (file-exists-p (persist--file-location sym)))
-     (should-error
-      (persist-save 'fred)))))
+(defmacro persist-test-persist-save (init default change printed-changed)
+  "Test persisting symbols.
+- symbol is not persisted when value is set to INIT and default
+  value is set to DEFAULT.
+- symbol is persisted when value is changed according to CHANGE.
+- persisted file contents match PRINTED-CHANGED.
+- symbol is not persisted after value is set back to DEFAULT."
+  `(with-local-temp-persist
+    (let ((sym (cl-gensym)))
+      (should-not (file-exists-p (persist--file-location sym)))
+      (set sym ,init)
+      (persist-symbol sym ,default)
+      (persist-save sym)
+      (should t)
+      (should-not (file-exists-p (persist--file-location sym)))
+      ,change
+      (persist-save sym)
+      (should (file-exists-p (persist--file-location sym)))
+      (should
+       (string-match-p
+        ,printed-changed
+        (with-temp-buffer
+          (insert-file-contents (persist--file-location sym))
+          (buffer-string))))
+      (set sym ,default)
+      (persist-save sym)
+      (should-not (file-exists-p (persist--file-location sym))))))
 
-(ert-deftest test-persist-save-non-number ()
-  "Test saving something that is not a number.
+(ert-deftest test-persist-save-number ()
+  "Test saving number."
+  (persist-test-persist-save 1 1 (set sym 2) "2"))
 
-`test-persist-save' missed "
-  (with-local-temp-persist
-   (let ((sym (cl-gensym)))
-     (set sym "fred")
-     (persist-symbol sym "fred")
-     (persist-save sym)
-     (should t)
-     (should-not (file-exists-p (persist--file-location sym)))
-     (set sym "george")
-     (persist-save sym)
-     (should (file-exists-p (persist--file-location sym)))
-     (should
-      (string-match-p
-       "george"
-       (with-temp-buffer
-         (insert-file-contents (persist--file-location sym))
-         (buffer-string)))))))
+(ert-deftest test-persist-save-string ()
+  "Test saving string."
+  (persist-test-persist-save "foo" "foo" (set sym "bar") "bar"))
 
 (ert-deftest test-persist-load ()
   (with-local-temp-persist
-- 
2.41.0

>From b379d8d1779e0190541ef7f8adf39dfe4d4c551a Mon Sep 17 00:00:00 2001
From: Joseph Turner <[email-masked]>
Date: Sat, 2 Sep 2023 16:52:31 -0700
Subject: [PATCH 2/5] Add persist-equal

* persist.el (persist-hash-equal): Like equal, but compares hash
tables also.
See bug#63671 for a discussion of built-in hash table comparison.
---
 persist.el | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/persist.el b/persist.el
index d80943d19e..a707d038cd 100644
--- a/persist.el
+++ b/persist.el
@@ -187,5 +187,25 @@ (defun persist--save-all ()
 (add-hook 'kill-emacs-hook
           'persist--save-all)
 
+(defun persist-equal (a b)
+  "Return non-nil when the values of A and B are equal.
+A and B are compared using `equal' unless they are both hash
+tables. In that case, the following are compared:
+
+- hash table count
+- hash table predicate
+- values, using `persist-equal'"
+  (if (and (hash-table-p a) (hash-table-p b))
+      (and (= (hash-table-count a) (hash-table-count b))
+           (eq (hash-table-test a) (hash-table-test b))
+           (catch 'done
+             (maphash
+              (lambda (key a-value)
+                (unless (persist-equal a-value (gethash key b (not a-value)))
+                  (throw 'done nil)))
+              a)
+             t))
+    (equal a b)))
+
 (provide 'persist)
 ;;; persist.el ends here
-- 
2.41.0

>From 11194569423dcdf8778a55f59dbca8f49e8b7b37 Mon Sep 17 00:00:00 2001
From: Joseph Turner <[email-masked]>
Date: Sun, 3 Sep 2023 17:10:38 -0700
Subject: [PATCH 3/5] Make persist-defvar work with hash tables

Previously, when persist-defvar received a hash table for an initial
value, updated values were not persisted.

* persist.el (persist-symbol): Use hash table copy as default so that
the original table can be modified without modifying the default value.
(persist-save): Use persist-equal to ensure that hash tables are
correctly compared
* test/persist-tests.el (test-persist-save-hash): Test hash tables
persistence.
---
 persist.el            | 8 +++++---
 test/persist-tests.el | 8 ++++++++
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/persist.el b/persist.el
index a707d038cd..7b2ab491d7 100644
--- a/persist.el
+++ b/persist.el
@@ -118,7 +118,9 @@ (defun persist-symbol (symbol &optional initvalue)
   (let ((initvalue (or initvalue (symbol-value symbol))))
     (add-to-list 'persist--symbols symbol)
     (put symbol 'persist t)
-    (put symbol 'persist-default initvalue)))
+    (if (hash-table-p initvalue)
+        (put symbol 'persist-default (copy-hash-table initvalue))
+      (put symbol 'persist-default initvalue))))
 
 (defun persist--persistant-p (symbol)
   "Return non-nil if SYMBOL is a persistant variable."
@@ -133,8 +135,8 @@ (defun persist-save (symbol)
     (error (format
             "Symbol %s is not persistant" symbol)))
   (let ((symbol-file-loc (persist--file-location symbol)))
-    (if (equal (symbol-value symbol)
-               (persist-default symbol))
+    (if (persist-equal (symbol-value symbol)
+                       (persist-default symbol))
         (when (file-exists-p symbol-file-loc)
           (delete-file symbol-file-loc))
       (let ((dir-loc
diff --git a/test/persist-tests.el b/test/persist-tests.el
index f2b04769ef..90adf1c6d6 100644
--- a/test/persist-tests.el
+++ b/test/persist-tests.el
@@ -61,6 +61,14 @@ (ert-deftest test-persist-save-string ()
   "Test saving string."
   (persist-test-persist-save "foo" "foo" (set sym "bar") "bar"))
 
+(ert-deftest test-persist-save-hash ()
+  "Test saving hash table."
+  (let* ((hash (make-hash-table))
+         (default (copy-hash-table hash)))
+    (persist-test-persist-save hash default
+                               (puthash 'foo "bar" (symbol-value sym))
+                               "#s(hash-table size 65 test eql rehash-size 1.5 rehash-threshold 0.8125 data (foo \"bar\"))")))
+
 (ert-deftest test-persist-load ()
   (with-local-temp-persist
    (let ((sym (cl-gensym)))
-- 
2.41.0

>From f360f7ae53125a847c2a8d5762ca5f08d16445b9 Mon Sep 17 00:00:00 2001
From: Joseph Turner <[email-masked]>
Date: Tue, 23 May 2023 13:43:02 -0700
Subject: [PATCH 4/5] Add persist-copy-tree

The behavior of copy-tree was changed in Emacs 30. This function will
ensure that persist works correctly for previous Emacs versions.

* persist.el (persist-copy-tree): Add copy-tree, so that records can
be compared.
---
 persist.el | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/persist.el b/persist.el
index 7b2ab491d7..93444995f2 100644
--- a/persist.el
+++ b/persist.el
@@ -209,5 +209,33 @@ (defun persist-equal (a b)
              t))
     (equal a b)))
 
+(defun persist-copy-tree (tree &optional vectors-and-records)
+  "Make a copy of TREE.
+If TREE is a cons cell, this recursively copies both its car and its cdr.
+Contrast to `copy-sequence', which copies only along the cdrs.
+With the second argument VECTORS-AND-RECORDS non-nil, this
+traverses and copies vectors and records as well as conses."
+  (declare (side-effect-free error-free))
+  (if (consp tree)
+      (let (result)
+	(while (consp tree)
+	  (let ((newcar (car tree)))
+	    (if (or (consp (car tree))
+                    (and vectors-and-records
+                         (or (vectorp (car tree)) (recordp (car tree)))))
+		(setq newcar (persist-copy-tree (car tree) vectors-and-records)))
+	    (push newcar result))
+	  (setq tree (cdr tree)))
+	(nconc (nreverse result)
+               (if (and vectors-and-records (or (vectorp tree) (recordp tree)))
+                   (persist-copy-tree tree vectors-and-records)
+                 tree)))
+    (if (and vectors-and-records (or (vectorp tree) (recordp tree)))
+	(let ((i (length (setq tree (copy-sequence tree)))))
+	  (while (>= (setq i (1- i)) 0)
+	    (aset tree i (persist-copy-tree (aref tree i) vectors-and-records)))
+	  tree)
+      tree)))
+
 (provide 'persist)
 ;;; persist.el ends here
-- 
2.41.0

>From ea57e6205b10678b9c26f7dcf3704e2a7acb25a7 Mon Sep 17 00:00:00 2001
From: Joseph Turner <[email-masked]>
Date: Tue, 23 May 2023 13:44:40 -0700
Subject: [PATCH 5/5] Make persist-defvar work with records

Previously, when persist-defvar received a record for an initial
value, updated values were not persisted.

* persist.el (persist-symbol): Set default to a copy of initvalue so
when initvalue is a record, the original can be modified without
modifying the default.
* test/persist-tests.el: Test persist-save with a record.
---
 persist.el            | 2 +-
 test/persist-tests.el | 8 ++++++++
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/persist.el b/persist.el
index 93444995f2..e43171459e 100644
--- a/persist.el
+++ b/persist.el
@@ -120,7 +120,7 @@ (defun persist-symbol (symbol &optional initvalue)
     (put symbol 'persist t)
     (if (hash-table-p initvalue)
         (put symbol 'persist-default (copy-hash-table initvalue))
-      (put symbol 'persist-default initvalue))))
+      (put symbol 'persist-default (persist-copy-tree initvalue t)))))
 
 (defun persist--persistant-p (symbol)
   "Return non-nil if SYMBOL is a persistant variable."
diff --git a/test/persist-tests.el b/test/persist-tests.el
index 90adf1c6d6..62d8501493 100644
--- a/test/persist-tests.el
+++ b/test/persist-tests.el
@@ -69,6 +69,14 @@ (ert-deftest test-persist-save-hash ()
                                (puthash 'foo "bar" (symbol-value sym))
                                "#s(hash-table size 65 test eql rehash-size 1.5 rehash-threshold 0.8125 data (foo \"bar\"))")))
 
+(ert-deftest test-persist-save-record ()
+  "Test saving record."
+  (let* ((rec (record 'foo 'a 'b))
+         (default (copy-sequence rec)))
+    (persist-test-persist-save rec default
+                               (setf (aref (symbol-value sym) 2) 'quux)
+                               "#s(foo a quux)")))
+
 (ert-deftest test-persist-load ()
   (with-local-temp-persist
    (let ((sym (cl-gensym)))
-- 
2.41.0