Commit c59ddb21 authored by Eric Abrahamsen's avatar Eric Abrahamsen

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.
parent 8b2ab501
......@@ -31,6 +31,7 @@
;;; Code:
(require 'eieio)
(require 'seq)
(eval-when-compile (require 'cl-lib))
;;; eieio-instance-inheritor
......@@ -308,14 +309,6 @@ Second, any text properties will be stripped from strings."
(= (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 +339,16 @@ Second, any text properties will be stripped from strings."
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 +405,9 @@ If no class is referenced there, then return nil."
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.
......
......@@ -195,6 +195,28 @@ persistent class.")
(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"))))
(unwind-protect
(persist-test-save-and-compare persist)
(ignore-errors (delete-file (oref persist file))))))
;;; Slot with a list of Objects
;;
;; A slot that contains another object that isn't persistent
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment