aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
authorGlenn Morris2018-03-22 07:50:37 -0700
committerGlenn Morris2018-03-22 07:50:37 -0700
commit0afb436eeb9b87dbd13b012e3b13d51fc6745f0d (patch)
tree683cf853c6bc6065a5f5a3d9ae81feda1882da95 /test
parent081c39beb0340f5d6084dc90796ba726a52c928e (diff)
parent8ac621bb5594786c66cc724864e6037c8c650774 (diff)
downloademacs-0afb436eeb9b87dbd13b012e3b13d51fc6745f0d.tar.gz
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')
-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 @@
1;;; eieio-persist.el --- Tests for eieio-persistent class 1;;; eieio-test-persist.el --- Tests for eieio-persistent class
2 2
3;; Copyright (C) 2011-2018 Free Software Foundation, Inc. 3;; Copyright (C) 2011-2018 Free Software Foundation, Inc.
4 4
@@ -40,6 +40,17 @@ This is usually a symbol that starts with `:'."
40 (car tuple) 40 (car tuple)
41 nil))) 41 nil)))
42 42
43(defun hash-equal (hash1 hash2)
44 "Compare two hash tables to see whether they are equal."
45 (and (= (hash-table-count hash1)
46 (hash-table-count hash2))
47 (catch 'flag
48 (maphash (lambda (x y)
49 (or (equal (gethash x hash2) y)
50 (throw 'flag nil)))
51 hash1)
52 (throw 'flag t))))
53
43(defun persist-test-save-and-compare (original) 54(defun persist-test-save-and-compare (original)
44 "Compare the object ORIGINAL against the one read fromdisk." 55 "Compare the object ORIGINAL against the one read fromdisk."
45 56
@@ -49,8 +60,8 @@ This is usually a symbol that starts with `:'."
49 (class (eieio-object-class original)) 60 (class (eieio-object-class original))
50 (fromdisk (eieio-persistent-read file class)) 61 (fromdisk (eieio-persistent-read file class))
51 (cv (cl--find-class class)) 62 (cv (cl--find-class class))
52 (slots (eieio--class-slots cv)) 63 (slots (eieio--class-slots cv)))
53 ) 64
54 (unless (object-of-class-p fromdisk class) 65 (unless (object-of-class-p fromdisk class)
55 (error "Persistent class %S != original class %S" 66 (error "Persistent class %S != original class %S"
56 (eieio-object-class fromdisk) 67 (eieio-object-class fromdisk)
@@ -62,18 +73,24 @@ This is usually a symbol that starts with `:'."
62 (origvalue (eieio-oref original oneslot)) 73 (origvalue (eieio-oref original oneslot))
63 (fromdiskvalue (eieio-oref fromdisk oneslot)) 74 (fromdiskvalue (eieio-oref fromdisk oneslot))
64 (initarg-p (eieio--attribute-to-initarg 75 (initarg-p (eieio--attribute-to-initarg
65 (cl--find-class class) oneslot)) 76 (cl--find-class class) oneslot)))
66 )
67 77
68 (if initarg-p 78 (if initarg-p
69 (unless (equal origvalue fromdiskvalue) 79 (unless
80 (cond ((and (hash-table-p origvalue) (hash-table-p fromdiskvalue))
81 (hash-equal origvalue fromdiskvalue))
82 (t (equal origvalue fromdiskvalue)))
70 (error "Slot %S Original Val %S != Persistent Val %S" 83 (error "Slot %S Original Val %S != Persistent Val %S"
71 oneslot origvalue fromdiskvalue)) 84 oneslot origvalue fromdiskvalue))
72 ;; Else !initarg-p 85 ;; Else !initarg-p
73 (unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue) 86 (let ((origval (cl--slot-descriptor-initform slot))
87 (diskval fromdiskvalue))
88 (unless
89 (cond ((and (hash-table-p origval) (hash-table-p diskval))
90 (hash-equal origval diskval))
91 (t (equal origval diskval)))
74 (error "Slot %S Persistent Val %S != Default Value %S" 92 (error "Slot %S Persistent Val %S != Default Value %S"
75 oneslot fromdiskvalue (cl--slot-descriptor-initform slot)))) 93 oneslot diskval origvalue))))))))
76 ))))
77 94
78;;; Simple Case 95;;; Simple Case
79;; 96;;
@@ -203,13 +220,16 @@ persistent class.")
203 ((slot1 :initarg :slot1 220 ((slot1 :initarg :slot1
204 :type (or persistent-random-class null persist-not-persistent)) 221 :type (or persistent-random-class null persist-not-persistent))
205 (slot2 :initarg :slot2 222 (slot2 :initarg :slot2
206 :type (or persist-not-persistent persist-random-class null)))) 223 :type (or persist-not-persistent persistent-random-class null))
224 (slot3 :initarg :slot3
225 :type persistent-random-class)))
207 226
208(ert-deftest eieio-test-multiple-class-slot () 227(ert-deftest eieio-test-multiple-class-slot ()
209 (let ((persist 228 (let ((persist
210 (persistent-multiclass-slot 229 (persistent-multiclass-slot
211 :slot1 (persistent-random-class) 230 :slot1 (persistent-random-class)
212 :slot2 (persist-not-persistent) 231 :slot2 (persist-not-persistent)
232 :slot3 (persistent-random-class)
213 :file (concat default-directory "test-ps5.pt")))) 233 :file (concat default-directory "test-ps5.pt"))))
214 (unwind-protect 234 (unwind-protect
215 (persist-test-save-and-compare persist) 235 (persist-test-save-and-compare persist)
@@ -235,4 +255,85 @@ persistent class.")
235 (persist-test-save-and-compare persist-wols) 255 (persist-test-save-and-compare persist-wols)
236 (delete-file (oref persist-wols file)))) 256 (delete-file (oref persist-wols file))))
237 257
258;;; Tests targeted at popular libraries in the wild.
259
260;; Objects inside hash tables and vectors (pcache), see bug#29220.
261(defclass person ()
262 ((name :type string :initarg :name)))
263
264(defclass classy (eieio-persistent)
265 ((teacher
266 :type person
267 :initarg :teacher)
268 (students
269 :initarg :students :initform (make-hash-table :test 'equal))
270 (janitors
271 :type list
272 :initarg :janitors)
273 (random-vector
274 :type vector
275 :initarg :random-vector)))
276
277(ert-deftest eieio-test-persist-hash-and-vector ()
278 (let* ((jane (make-instance 'person :name "Jane"))
279 (bob (make-instance 'person :name "Bob"))
280 (hans (make-instance 'person :name "Hans"))
281 (dierdre (make-instance 'person :name "Dierdre"))
282 (class (make-instance 'classy
283 :teacher jane
284 :janitors (list [tuesday nil]
285 [friday nil])
286 :random-vector [nil]
287 :file (concat default-directory "classy-" emacs-version ".eieio"))))
288 (puthash "Bob" bob (slot-value class 'students))
289 (aset (slot-value class 'random-vector) 0
290 (make-instance 'persistent-random-class))
291 (unwind-protect
292 (persist-test-save-and-compare class)
293 (delete-file (oref class file)))
294 (aset (car (slot-value class 'janitors)) 1 hans)
295 (aset (nth 1 (slot-value class 'janitors)) 1 dierdre)
296 (unwind-protect
297 ;; FIXME: This should not error.
298 (should-error (persist-test-save-and-compare class))
299 (delete-file (oref class file)))))
300
301;; Extra quotation of lists inside other objects (Gnus registry), also
302;; bug#29220.
303
304(defclass eieio-container (eieio-persistent)
305 ((alist
306 :initarg :alist
307 :type list)
308 (vec
309 :initarg :vec
310 :type vector)
311 (htab
312 :initarg :htab
313 :type hash-table)))
314
315(ert-deftest eieio-test-persist-interior-lists ()
316 (let* ((thing (make-instance
317 'eieio-container
318 :vec [nil]
319 :htab (make-hash-table :test #'equal)
320 :file (concat default-directory
321 "container-" emacs-version ".eieio")))
322 (john (make-instance 'person :name "John"))
323 (alexie (make-instance 'person :name "Alexie"))
324 (alst '(("first" (one two three))
325 ("second" (four five six)))))
326 (setf (slot-value thing 'alist) alst)
327 (puthash "alst" alst (slot-value thing 'htab))
328 (aset (slot-value thing 'vec) 0 alst)
329 (unwind-protect
330 (persist-test-save-and-compare thing)
331 (delete-file (slot-value thing 'file)))
332 (setf (nth 2 (cadar alst)) john
333 (nth 2 (cadadr alst)) alexie)
334 (unwind-protect
335 ;; FIXME: Should not error.
336 (should-error (persist-test-save-and-compare thing))
337 (delete-file (slot-value thing 'file)))))
338
238;;; eieio-test-persist.el ends here 339;;; eieio-test-persist.el ends here