summaryrefslogtreecommitdiff
path: root/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
diff options
context:
space:
mode:
authorGlenn Morris <rgm@gnu.org>2018-03-22 07:50:37 -0700
committerGlenn Morris <rgm@gnu.org>2018-03-22 07:50:37 -0700
commit0afb436eeb9b87dbd13b012e3b13d51fc6745f0d (patch)
tree683cf853c6bc6065a5f5a3d9ae81feda1882da95 /test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
parent081c39beb0340f5d6084dc90796ba726a52c928e (diff)
parent8ac621bb5594786c66cc724864e6037c8c650774 (diff)
downloademacs-0afb436eeb9b87dbd13b012e3b13d51fc6745f0d.tar.gz
emacs-0afb436eeb9b87dbd13b012e3b13d51fc6745f0d.tar.bz2
emacs-0afb436eeb9b87dbd13b012e3b13d51fc6745f0d.zip
Merge from origin/emacs-26
8ac621b (origin/emacs-26) Document DEFUN attributes 16d0cc7 * etc/NEWS: Add an entry for auth-source-pass. cc1702f Fix the MSDOS build daa9e85 Improve warning and error messages 7612dd1 Adjust eieio persistence tests for expected failure f0cf4dc Let eieio-persistent-read read what object-write has written 40ad1ff Handle possible classtype values in eieio-persistent-read 4ec935d Add new tests for eieio persistence 47917d8 * lisp/gnus/gnus-cloud.el (gnus-cloud-synced-files): Fix doc ... e32f352 * lisp/ibuf-ext.el (ibuffer-never-search-content-mode): Fix t... 5268f30 * doc/lispref/windows.texi (Selecting Windows): Fix a typo. 143b485 * doc/lispref/internals.texi (Writing Emacs Primitives): Fix ... 4ab4551 Firm up documentation of generalized variables a5bf099 Improve documentation of Auto-Revert mode ed05eaa Improvements in dired.texi Conflicts: etc/NEWS
Diffstat (limited to 'test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el')
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el121
1 files changed, 111 insertions, 10 deletions
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
index b485972078d..f5c25e64912 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
@@ -1,4 +1,4 @@
-;;; eieio-persist.el --- Tests for eieio-persistent class
+;;; eieio-test-persist.el --- Tests for eieio-persistent class
;; Copyright (C) 2011-2018 Free Software Foundation, Inc.
@@ -40,6 +40,17 @@ This is usually a symbol that starts with `:'."
(car tuple)
nil)))
+(defun hash-equal (hash1 hash2)
+ "Compare two hash tables to see whether they are equal."
+ (and (= (hash-table-count hash1)
+ (hash-table-count hash2))
+ (catch 'flag
+ (maphash (lambda (x y)
+ (or (equal (gethash x hash2) y)
+ (throw 'flag nil)))
+ hash1)
+ (throw 'flag t))))
+
(defun persist-test-save-and-compare (original)
"Compare the object ORIGINAL against the one read fromdisk."
@@ -49,8 +60,8 @@ This is usually a symbol that starts with `:'."
(class (eieio-object-class original))
(fromdisk (eieio-persistent-read file class))
(cv (cl--find-class class))
- (slots (eieio--class-slots cv))
- )
+ (slots (eieio--class-slots cv)))
+
(unless (object-of-class-p fromdisk class)
(error "Persistent class %S != original class %S"
(eieio-object-class fromdisk)
@@ -62,18 +73,24 @@ This is usually a symbol that starts with `:'."
(origvalue (eieio-oref original oneslot))
(fromdiskvalue (eieio-oref fromdisk oneslot))
(initarg-p (eieio--attribute-to-initarg
- (cl--find-class class) oneslot))
- )
+ (cl--find-class class) oneslot)))
(if initarg-p
- (unless (equal origvalue fromdiskvalue)
+ (unless
+ (cond ((and (hash-table-p origvalue) (hash-table-p fromdiskvalue))
+ (hash-equal origvalue fromdiskvalue))
+ (t (equal origvalue fromdiskvalue)))
(error "Slot %S Original Val %S != Persistent Val %S"
oneslot origvalue fromdiskvalue))
;; Else !initarg-p
- (unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue)
+ (let ((origval (cl--slot-descriptor-initform slot))
+ (diskval fromdiskvalue))
+ (unless
+ (cond ((and (hash-table-p origval) (hash-table-p diskval))
+ (hash-equal origval diskval))
+ (t (equal origval diskval)))
(error "Slot %S Persistent Val %S != Default Value %S"
- oneslot fromdiskvalue (cl--slot-descriptor-initform slot))))
- ))))
+ oneslot diskval origvalue))))))))
;;; Simple Case
;;
@@ -203,13 +220,16 @@ persistent class.")
((slot1 :initarg :slot1
:type (or persistent-random-class null persist-not-persistent))
(slot2 :initarg :slot2
- :type (or persist-not-persistent persist-random-class null))))
+ :type (or persist-not-persistent persistent-random-class null))
+ (slot3 :initarg :slot3
+ :type persistent-random-class)))
(ert-deftest eieio-test-multiple-class-slot ()
(let ((persist
(persistent-multiclass-slot
:slot1 (persistent-random-class)
:slot2 (persist-not-persistent)
+ :slot3 (persistent-random-class)
:file (concat default-directory "test-ps5.pt"))))
(unwind-protect
(persist-test-save-and-compare persist)
@@ -235,4 +255,85 @@ persistent class.")
(persist-test-save-and-compare persist-wols)
(delete-file (oref persist-wols file))))
+;;; Tests targeted at popular libraries in the wild.
+
+;; Objects inside hash tables and vectors (pcache), see bug#29220.
+(defclass person ()
+ ((name :type string :initarg :name)))
+
+(defclass classy (eieio-persistent)
+ ((teacher
+ :type person
+ :initarg :teacher)
+ (students
+ :initarg :students :initform (make-hash-table :test 'equal))
+ (janitors
+ :type list
+ :initarg :janitors)
+ (random-vector
+ :type vector
+ :initarg :random-vector)))
+
+(ert-deftest eieio-test-persist-hash-and-vector ()
+ (let* ((jane (make-instance 'person :name "Jane"))
+ (bob (make-instance 'person :name "Bob"))
+ (hans (make-instance 'person :name "Hans"))
+ (dierdre (make-instance 'person :name "Dierdre"))
+ (class (make-instance 'classy
+ :teacher jane
+ :janitors (list [tuesday nil]
+ [friday nil])
+ :random-vector [nil]
+ :file (concat default-directory "classy-" emacs-version ".eieio"))))
+ (puthash "Bob" bob (slot-value class 'students))
+ (aset (slot-value class 'random-vector) 0
+ (make-instance 'persistent-random-class))
+ (unwind-protect
+ (persist-test-save-and-compare class)
+ (delete-file (oref class file)))
+ (aset (car (slot-value class 'janitors)) 1 hans)
+ (aset (nth 1 (slot-value class 'janitors)) 1 dierdre)
+ (unwind-protect
+ ;; FIXME: This should not error.
+ (should-error (persist-test-save-and-compare class))
+ (delete-file (oref class file)))))
+
+;; Extra quotation of lists inside other objects (Gnus registry), also
+;; bug#29220.
+
+(defclass eieio-container (eieio-persistent)
+ ((alist
+ :initarg :alist
+ :type list)
+ (vec
+ :initarg :vec
+ :type vector)
+ (htab
+ :initarg :htab
+ :type hash-table)))
+
+(ert-deftest eieio-test-persist-interior-lists ()
+ (let* ((thing (make-instance
+ 'eieio-container
+ :vec [nil]
+ :htab (make-hash-table :test #'equal)
+ :file (concat default-directory
+ "container-" emacs-version ".eieio")))
+ (john (make-instance 'person :name "John"))
+ (alexie (make-instance 'person :name "Alexie"))
+ (alst '(("first" (one two three))
+ ("second" (four five six)))))
+ (setf (slot-value thing 'alist) alst)
+ (puthash "alst" alst (slot-value thing 'htab))
+ (aset (slot-value thing 'vec) 0 alst)
+ (unwind-protect
+ (persist-test-save-and-compare thing)
+ (delete-file (slot-value thing 'file)))
+ (setf (nth 2 (cadar alst)) john
+ (nth 2 (cadadr alst)) alexie)
+ (unwind-protect
+ ;; FIXME: Should not error.
+ (should-error (persist-test-save-and-compare thing))
+ (delete-file (slot-value thing 'file)))))
+
;;; eieio-test-persist.el ends here