Use plain symbols for eieio type descriptors (Bug#29220)
Since Emacs 26, eieio objects use a class record (with circular references) as the type descriptor of the object record. This causes problems when reading back an object from a string, because the class record is not `eq' to the canonical one (which means that read objects don't satisfy the foo-p predicate). * lisp/emacs-lisp/eieio.el (make-instance): As a (partial) fix, set the record's type descriptor to a plain symbol for the type descriptor when eieio-backward-compatibility is non-nil (the default). * lisp/emacs-lisp/eieio-core.el (eieio--object-class): Call eieio--class-object on the type tag when eieio-backward-compatibility is non-nil. (eieio-object-p): Use eieio--object-class instead of eieio--object-class-tag. * test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el (eieio-test-persist-hash-and-vector) (eieio-test-persist-interior-lists): Make into functions. (eieio-persist-hash-and-vector-backward-compatibility) (eieio-persist-hash-and-vector-no-backward-compatibility) (eieio-test-persist-interior-lists-backward-compatibility) (eieio-test-persist-interior-lists-no-backward-compatibility): New tests which call them, eieio-backward-compatibility let-bound.
This commit is contained in:
parent
4b24b0185d
commit
5f01af6c8e
3 changed files with 32 additions and 10 deletions
|
@ -117,9 +117,6 @@ Currently under control of this var:
|
||||||
(defsubst eieio--object-class-tag (obj)
|
(defsubst eieio--object-class-tag (obj)
|
||||||
(aref obj 0))
|
(aref obj 0))
|
||||||
|
|
||||||
(defsubst eieio--object-class (obj)
|
|
||||||
(eieio--object-class-tag obj))
|
|
||||||
|
|
||||||
|
|
||||||
;;; Important macros used internally in eieio.
|
;;; Important macros used internally in eieio.
|
||||||
|
|
||||||
|
@ -132,6 +129,12 @@ Currently under control of this var:
|
||||||
(or (cl--find-class class) class)
|
(or (cl--find-class class) class)
|
||||||
class))
|
class))
|
||||||
|
|
||||||
|
(defsubst eieio--object-class (obj)
|
||||||
|
(let ((tag (eieio--object-class-tag obj)))
|
||||||
|
(if eieio-backward-compatibility
|
||||||
|
(eieio--class-object tag)
|
||||||
|
tag)))
|
||||||
|
|
||||||
(defun class-p (x)
|
(defun class-p (x)
|
||||||
"Return non-nil if X is a valid class vector.
|
"Return non-nil if X is a valid class vector.
|
||||||
X can also be is a symbol."
|
X can also be is a symbol."
|
||||||
|
@ -163,7 +166,7 @@ Return nil if that option doesn't exist."
|
||||||
(defun eieio-object-p (obj)
|
(defun eieio-object-p (obj)
|
||||||
"Return non-nil if OBJ is an EIEIO object."
|
"Return non-nil if OBJ is an EIEIO object."
|
||||||
(and (recordp obj)
|
(and (recordp obj)
|
||||||
(eieio--class-p (eieio--object-class-tag obj))))
|
(eieio--class-p (eieio--object-class obj))))
|
||||||
|
|
||||||
(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
|
(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
|
||||||
|
|
||||||
|
|
|
@ -710,6 +710,9 @@ calls `initialize-instance' on that object."
|
||||||
;; Call the initialize method on the new object with the slots
|
;; Call the initialize method on the new object with the slots
|
||||||
;; that were passed down to us.
|
;; that were passed down to us.
|
||||||
(initialize-instance new-object slots)
|
(initialize-instance new-object slots)
|
||||||
|
(when eieio-backward-compatibility
|
||||||
|
;; Use symbol as type descriptor, for backwards compatibility.
|
||||||
|
(aset new-object 0 class))
|
||||||
;; Return the created object.
|
;; Return the created object.
|
||||||
new-object))
|
new-object))
|
||||||
|
|
||||||
|
|
|
@ -277,7 +277,7 @@ persistent class.")
|
||||||
:type vector
|
:type vector
|
||||||
:initarg :random-vector)))
|
:initarg :random-vector)))
|
||||||
|
|
||||||
(ert-deftest eieio-test-persist-hash-and-vector ()
|
(defun eieio-test-persist-hash-and-vector ()
|
||||||
(let* ((jane (make-instance 'person :name "Jane"))
|
(let* ((jane (make-instance 'person :name "Jane"))
|
||||||
(bob (make-instance 'person :name "Bob"))
|
(bob (make-instance 'person :name "Bob"))
|
||||||
(hans (make-instance 'person :name "Hans"))
|
(hans (make-instance 'person :name "Hans"))
|
||||||
|
@ -297,10 +297,18 @@ persistent class.")
|
||||||
(aset (car (slot-value class 'janitors)) 1 hans)
|
(aset (car (slot-value class 'janitors)) 1 hans)
|
||||||
(aset (nth 1 (slot-value class 'janitors)) 1 dierdre)
|
(aset (nth 1 (slot-value class 'janitors)) 1 dierdre)
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
;; FIXME: This should not error.
|
(persist-test-save-and-compare class)
|
||||||
(should-error (persist-test-save-and-compare class))
|
|
||||||
(delete-file (oref class file)))))
|
(delete-file (oref class file)))))
|
||||||
|
|
||||||
|
(ert-deftest eieio-persist-hash-and-vector-backward-compatibility ()
|
||||||
|
(let ((eieio-backward-compatibility t)) ; The default.
|
||||||
|
(eieio-test-persist-hash-and-vector)))
|
||||||
|
|
||||||
|
(ert-deftest eieio-persist-hash-and-vector-no-backward-compatibility ()
|
||||||
|
:expected-result :failed ;; Bug#29220.
|
||||||
|
(let ((eieio-backward-compatibility nil))
|
||||||
|
(eieio-test-persist-hash-and-vector)))
|
||||||
|
|
||||||
;; Extra quotation of lists inside other objects (Gnus registry), also
|
;; Extra quotation of lists inside other objects (Gnus registry), also
|
||||||
;; bug#29220.
|
;; bug#29220.
|
||||||
|
|
||||||
|
@ -315,7 +323,7 @@ persistent class.")
|
||||||
:initarg :htab
|
:initarg :htab
|
||||||
:type hash-table)))
|
:type hash-table)))
|
||||||
|
|
||||||
(ert-deftest eieio-test-persist-interior-lists ()
|
(defun eieio-test-persist-interior-lists ()
|
||||||
(let* ((thing (make-instance
|
(let* ((thing (make-instance
|
||||||
'eieio-container
|
'eieio-container
|
||||||
:vec [nil]
|
:vec [nil]
|
||||||
|
@ -335,8 +343,16 @@ persistent class.")
|
||||||
(setf (nth 2 (cadar alst)) john
|
(setf (nth 2 (cadar alst)) john
|
||||||
(nth 2 (cadadr alst)) alexie)
|
(nth 2 (cadadr alst)) alexie)
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
;; FIXME: Should not error.
|
(persist-test-save-and-compare thing)
|
||||||
(should-error (persist-test-save-and-compare thing))
|
|
||||||
(delete-file (slot-value thing 'file)))))
|
(delete-file (slot-value thing 'file)))))
|
||||||
|
|
||||||
|
(ert-deftest eieio-test-persist-interior-lists-backward-compatibility ()
|
||||||
|
(let ((eieio-backward-compatibility t)) ; The default.
|
||||||
|
(eieio-test-persist-interior-lists)))
|
||||||
|
|
||||||
|
(ert-deftest eieio-test-persist-interior-lists-no-backward-compatibility ()
|
||||||
|
:expected-result :failed ;; Bug#29220.
|
||||||
|
(let ((eieio-backward-compatibility nil))
|
||||||
|
(eieio-test-persist-interior-lists)))
|
||||||
|
|
||||||
;;; eieio-test-persist.el ends here
|
;;; eieio-test-persist.el ends here
|
||||||
|
|
Loading…
Add table
Reference in a new issue