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.
This commit is contained in:
parent
8b2ab5014b
commit
c59ddb2120
2 changed files with 36 additions and 15 deletions
|
@ -31,6 +31,7 @@
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(require 'eieio)
|
(require 'eieio)
|
||||||
|
(require 'seq)
|
||||||
(eval-when-compile (require 'cl-lib))
|
(eval-when-compile (require 'cl-lib))
|
||||||
|
|
||||||
;;; eieio-instance-inheritor
|
;;; eieio-instance-inheritor
|
||||||
|
@ -308,14 +309,6 @@ Second, any text properties will be stripped from strings."
|
||||||
(= (length proposed-value) 1))
|
(= (length proposed-value) 1))
|
||||||
nil)
|
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.
|
;; List of object constructors.
|
||||||
((and (eq (car proposed-value) 'list)
|
((and (eq (car proposed-value) 'list)
|
||||||
;; 2nd item is a list.
|
;; 2nd item is a list.
|
||||||
|
@ -346,6 +339,16 @@ Second, any text properties will be stripped from strings."
|
||||||
objlist))
|
objlist))
|
||||||
;; return the list of objects ... reversed.
|
;; return the list of objects ... reversed.
|
||||||
(nreverse objlist)))
|
(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
|
(t
|
||||||
proposed-value))))
|
proposed-value))))
|
||||||
|
|
||||||
|
@ -402,13 +405,9 @@ If no class is referenced there, then return nil."
|
||||||
type))
|
type))
|
||||||
|
|
||||||
((eq (car-safe type) 'or)
|
((eq (car-safe type) 'or)
|
||||||
;; If type is a list, and is an or, it is possibly something
|
;; If type is a list, and is an `or', return all valid class
|
||||||
;; like (or null myclass), so check for that.
|
;; types within the `or' statement.
|
||||||
(let ((ans nil))
|
(seq-filter #'eieio-persistent-slot-type-is-class-p (cdr type)))
|
||||||
(dolist (subtype (cdr type))
|
|
||||||
(setq ans (eieio-persistent-slot-type-is-class-p
|
|
||||||
subtype)))
|
|
||||||
ans))
|
|
||||||
|
|
||||||
(t
|
(t
|
||||||
;; No match, not a class.
|
;; No match, not a class.
|
||||||
|
|
|
@ -195,6 +195,28 @@ persistent class.")
|
||||||
(persist-test-save-and-compare persist-woss)
|
(persist-test-save-and-compare persist-woss)
|
||||||
(delete-file (oref persist-woss file))))
|
(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"))))
|
||||||
|
(unwind-protect
|
||||||
|
(persist-test-save-and-compare persist)
|
||||||
|
(ignore-errors (delete-file (oref persist file))))))
|
||||||
|
|
||||||
;;; Slot with a list of Objects
|
;;; Slot with a list of Objects
|
||||||
;;
|
;;
|
||||||
;; A slot that contains another object that isn't persistent
|
;; A slot that contains another object that isn't persistent
|
||||||
|
|
Loading…
Add table
Reference in a new issue