aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEric Abrahamsen2017-09-30 10:57:52 -0700
committerEric Abrahamsen2017-09-30 16:28:00 -0700
commitc59ddb212055609ec0c402708a2514ee6a30e836 (patch)
treef947e55c19617feba81f1115e926bcf6eaad7df7
parent8b2ab5014b2c1641bb62efa63b9ee54b4c056b5a (diff)
downloademacs-c59ddb212055609ec0c402708a2514ee6a30e836.tar.gz
emacs-c59ddb212055609ec0c402708a2514ee6a30e836.zip
Fix slot typecheck in eieio-persistent
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p): An `or' form can specify multiple potential classes (or null) as valid types for a slot, but previously only the final element of the `or' was actually checked. Now returns all valid classes in the `or' form. (eieio-persistent-validate/fix-slot-value): Check if proposed value matches any of the valid classes. * test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el (eieio-test-multiple-class-slot): Test this behavior.
-rw-r--r--lisp/emacs-lisp/eieio-base.el29
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el22
2 files changed, 36 insertions, 15 deletions
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 6b39b4f2622..e3501be6c1d 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -31,6 +31,7 @@
31;;; Code: 31;;; Code:
32 32
33(require 'eieio) 33(require 'eieio)
34(require 'seq)
34(eval-when-compile (require 'cl-lib)) 35(eval-when-compile (require 'cl-lib))
35 36
36;;; eieio-instance-inheritor 37;;; eieio-instance-inheritor
@@ -308,14 +309,6 @@ Second, any text properties will be stripped from strings."
308 (= (length proposed-value) 1)) 309 (= (length proposed-value) 1))
309 nil) 310 nil)
310 311
311 ;; We have a slot with a single object that can be
312 ;; saved here. Recurse and evaluate that
313 ;; sub-object.
314 ((and classtype (class-p classtype)
315 (child-of-class-p (car proposed-value) classtype))
316 (eieio-persistent-convert-list-to-object
317 proposed-value))
318
319 ;; List of object constructors. 312 ;; List of object constructors.
320 ((and (eq (car proposed-value) 'list) 313 ((and (eq (car proposed-value) 'list)
321 ;; 2nd item is a list. 314 ;; 2nd item is a list.
@@ -346,6 +339,16 @@ Second, any text properties will be stripped from strings."
346 objlist)) 339 objlist))
347 ;; return the list of objects ... reversed. 340 ;; return the list of objects ... reversed.
348 (nreverse objlist))) 341 (nreverse objlist)))
342 ;; We have a slot with a single object that can be
343 ;; saved here. Recurse and evaluate that
344 ;; sub-object.
345 ((and classtype
346 (seq-some
347 (lambda (elt)
348 (child-of-class-p (car proposed-value) elt))
349 classtype))
350 (eieio-persistent-convert-list-to-object
351 proposed-value))
349 (t 352 (t
350 proposed-value)))) 353 proposed-value))))
351 354
@@ -402,13 +405,9 @@ If no class is referenced there, then return nil."
402 type)) 405 type))
403 406
404 ((eq (car-safe type) 'or) 407 ((eq (car-safe type) 'or)
405 ;; If type is a list, and is an or, it is possibly something 408 ;; If type is a list, and is an `or', return all valid class
406 ;; like (or null myclass), so check for that. 409 ;; types within the `or' statement.
407 (let ((ans nil)) 410 (seq-filter #'eieio-persistent-slot-type-is-class-p (cdr type)))
408 (dolist (subtype (cdr type))
409 (setq ans (eieio-persistent-slot-type-is-class-p
410 subtype)))
411 ans))
412 411
413 (t 412 (t
414 ;; No match, not a class. 413 ;; No match, not a class.
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 e2cff3fbcaa..738711c9c84 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
@@ -195,6 +195,28 @@ persistent class.")
195 (persist-test-save-and-compare persist-woss) 195 (persist-test-save-and-compare persist-woss)
196 (delete-file (oref persist-woss file)))) 196 (delete-file (oref persist-woss file))))
197 197
198;; A slot that can contain one of two different classes, to exercise
199;; the `or' slot type.
200
201(defclass persistent-random-class ()
202 ())
203
204(defclass persistent-multiclass-slot (eieio-persistent)
205 ((slot1 :initarg :slot1
206 :type (or persistent-random-class null persist-not-persistent))
207 (slot2 :initarg :slot2
208 :type (or persist-not-persistent persist-random-class null))))
209
210(ert-deftest eieio-test-multiple-class-slot ()
211 (let ((persist
212 (persistent-multiclass-slot "random string"
213 :slot1 (persistent-random-class)
214 :slot2 (persist-not-persistent)
215 :file (concat default-directory "test-ps5.pt"))))
216 (unwind-protect
217 (persist-test-save-and-compare persist)
218 (ignore-errors (delete-file (oref persist file))))))
219
198;;; Slot with a list of Objects 220;;; Slot with a list of Objects
199;; 221;;
200;; A slot that contains another object that isn't persistent 222;; A slot that contains another object that isn't persistent