diff options
author | Glenn Morris <rgm@gnu.org> | 2018-03-22 07:50:37 -0700 |
---|---|---|
committer | Glenn Morris <rgm@gnu.org> | 2018-03-22 07:50:37 -0700 |
commit | 0afb436eeb9b87dbd13b012e3b13d51fc6745f0d (patch) | |
tree | 683cf853c6bc6065a5f5a3d9ae81feda1882da95 /test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el | |
parent | 081c39beb0340f5d6084dc90796ba726a52c928e (diff) | |
parent | 8ac621bb5594786c66cc724864e6037c8c650774 (diff) | |
download | emacs-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.el | 121 |
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 |