>From 45c2e7ffbbcbe564b816af85274ac84a170fca3e Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 30 Sep 2017 10:57:52 -0700 Subject: [PATCH] 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. * lisp/emacs-lisp/eieio-base.el (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. --- lisp/emacs-lisp/eieio-base.el | 28 ++++++++++------------ .../emacs-lisp/eieio-tests/eieio-test-persist.el | 21 ++++++++++++++++ 2 files changed, 34 insertions(+), 15 deletions(-) diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 6b39b4f262..1ddf9c4460 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -308,14 +308,6 @@ eieio-persistent-validate/fix-slot-value (= (length proposed-value) 1)) nil) - ;; We have a slot with a single object that can be - ;; saved here. Recurse and evaluate that - ;; sub-object. - ((and classtype (class-p classtype) - (child-of-class-p (car proposed-value) classtype)) - (eieio-persistent-convert-list-to-object - proposed-value)) - ;; List of object constructors. ((and (eq (car proposed-value) 'list) ;; 2nd item is a list. @@ -346,6 +338,16 @@ eieio-persistent-validate/fix-slot-value objlist)) ;; return the list of objects ... reversed. (nreverse objlist))) + ;; We have a slot with a single object that can be + ;; saved here. Recurse and evaluate that + ;; sub-object. + ((and classtype + (seq-some + (lambda (elt) + (child-of-class-p (car proposed-value) elt)) + classtype)) + (eieio-persistent-convert-list-to-object + proposed-value)) (t proposed-value)))) @@ -402,13 +404,9 @@ eieio-persistent-slot-type-is-class-p type)) ((eq (car-safe type) 'or) - ;; If type is a list, and is an or, it is possibly something - ;; like (or null myclass), so check for that. - (let ((ans nil)) - (dolist (subtype (cdr type)) - (setq ans (eieio-persistent-slot-type-is-class-p - subtype))) - ans)) + ;; If type is a list, and is an `or', return all valid class + ;; types within the `or' statement. + (seq-filter #'eieio-persistent-slot-type-is-class-p (cdr type))) (t ;; 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 e2cff3fbca..59eb287bc9 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,27 @@ persistent-with-objs-slot-subs (persist-test-save-and-compare persist-woss) (delete-file (oref persist-woss file)))) +;; A slot that can contain one of two different classes, to exercise +;; the `or' slot type. + +(defclass persistent-random-class () + ()) + +(defclass persistent-multiclass-slot (eieio-persistent) + ((slot1 :initarg :slot1 + :type (or persistent-random-class null persist-not-persistent)) + (slot2 :initarg :slot2 + :type (or persist-not-persistent persist-random-class null)))) + +(ert-deftest eieio-test-multiple-class-slot () + (let ((persist + (persistent-multiclass-slot "random string" + :slot1 (persistent-random-class) + :slot2 (persist-not-persistent) + :file (concat default-directory "test-ps5.pt")))) + (persist-test-save-and-compare persist) + (delete-file (oref persist file)))) + ;;; Slot with a list of Objects ;; ;; A slot that contains another object that isn't persistent -- 2.14.2