diff options
| author | Eric Abrahamsen | 2017-09-30 10:57:52 -0700 |
|---|---|---|
| committer | Eric Abrahamsen | 2017-09-30 16:28:00 -0700 |
| commit | c59ddb212055609ec0c402708a2514ee6a30e836 (patch) | |
| tree | f947e55c19617feba81f1115e926bcf6eaad7df7 | |
| parent | 8b2ab5014b2c1641bb62efa63b9ee54b4c056b5a (diff) | |
| download | emacs-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.el | 29 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el | 22 |
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 |