* bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation
@ 2017-12-03 0:10 Eric Abrahamsen
2019-06-24 20:28 ` Lars Ingebrigtsen
0 siblings, 1 reply; 7+ messages in thread
From: Eric Abrahamsen @ 2017-12-03 0:10 UTC (permalink / raw)
To: 29541
[-- Attachment #1: Type: text/plain, Size: 1501 bytes --]
The attached patch is a proposal that would replace the function
`eieio-persistent-convert-list-to-object' with a generic method
`eieio-persistent-make-instance'. It also removes all slot validation in
the read process.
Considerations:
1. `object-write' is already a method. That means the writing process
can be overridden and customized, but the reading process can't, which
removes most of the benefit of being able to override the write. This
would allow "matching" methods for writing and reading.
2. This version checks *all* slot values, including all elements inside
lists, cons-cells, etc. The safety consideration is mostly removing text
properties (specifically the display property), and this version checks
exhaustively.
3. I removed slot validation because it complicates the restoration
process, and because all the validation will be done again, and done
better, by `cl-typep' in the `initialize-instance' process. There's not
much reason to have a "pre-check", as errors are raised in both cases.
4. This version goes slightly faster than the old one (admittedly,
probably just because it omits type-checking).
Persistence format isn't changed, so this should be backwards
compatible.
I suppose the removal of validation might not be welcome, but at least I
hope the function->generic change is acceptable.
In GNU Emacs 27.0.50 (build 13, x86_64-pc-linux-gnu, GTK+ Version 3.22.26)
of 2017-11-30 built on slip
Repository revision: 3f3d98ee5851840228786390ee7dbf851d144eb8
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Replace-eieio-persistent-convert-list-to-object-with.patch --]
[-- Type: text/x-diff, Size: 13559 bytes --]
From 858b6ca64ad088362800e3ce4d5c0b34114f9b06 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Sat, 2 Dec 2017 15:21:51 -0800
Subject: [PATCH] Replace eieio-persistent-convert-list-to-object with method
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-make-instance): New
generic function that replaces
eieio-persistent-convert-list-to-object.
eieio-persistent-validate/fix-slot-value has been renamed to
eieio-persistent-fix-value, and
eieio-persistent-slot-type-is-class-p has been removed, as this
process no longer does any validation, instead allowing that to
happen at initialize-instance time.
* test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
(eieio-test-string-restoration): New test making sure string
properties are stripped.
---
lisp/emacs-lisp/eieio-base.el | 235 ++++++---------------
.../emacs-lisp/eieio-tests/eieio-test-persist.el | 58 +++++
2 files changed, 123 insertions(+), 170 deletions(-)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 58dcd09d7e..e1a00f82a3 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -236,185 +236,80 @@ eieio-persistent-read
(when (not (child-of-class-p (car ret) 'eieio-persistent))
(error "Corrupt object on disk: Unknown saved object"))
(when (and class
- (not (or (eq (car ret) class ) ; same class
+ (not (or (eq (car ret) class)
(and allow-subclass
- (child-of-class-p (car ret) class)) ; subclasses
- )))
+ (child-of-class-p (car ret) class)))))
(error "Corrupt object on disk: Invalid saved class"))
- (setq ret (eieio-persistent-convert-list-to-object ret))
+ (setq ret (eieio-persistent-make-instance (car ret) (cdr ret)))
(oset ret file filename))
(kill-buffer " *tmp eieio read*"))
ret))
-(defun eieio-persistent-convert-list-to-object (inputlist)
- "Convert the INPUTLIST, representing object creation to an object.
-While it is possible to just `eval' the INPUTLIST, this code instead
-validates the existing list, and explicitly creates objects instead of
-calling eval. This avoids the possibility of accidentally running
-malicious code.
+(cl-defmethod eieio-persistent-make-instance
+ ((cls (subclass eieio-default-superclass))
+ slot-list)
+ "Use values in SLOT-LIST to create an object of class CLS.
+ While it is possible to just `eval' the SLOT-LIST, this code
+instead validates the existing list, and explicitly creates
+objects instead of calling eval. This avoids the possibility of
+accidentally running malicious code.
Note: This function recurses when a slot of :type of some object is
identified, and needing more object creation."
- (let* ((objclass (nth 0 inputlist))
- ;; Earlier versions of `object-write' added a string name for
- ;; the object, now obsolete.
- (slots (nthcdr
- (if (stringp (nth 1 inputlist)) 2 1)
- inputlist))
- (createslots nil)
- (class
- (progn
- ;; If OBJCLASS is an eieio autoload object, then we need to
- ;; load it.
- (eieio-class-un-autoload objclass)
- (eieio--class-object objclass))))
-
- (while slots
- (let ((initarg (car slots))
- (value (car (cdr slots))))
-
- ;; Make sure that the value proposed for SLOT is valid.
- ;; In addition, strip out quotes, list functions, and update
- ;; object constructors as needed.
- (setq value (eieio-persistent-validate/fix-slot-value
- class (eieio--initarg-to-attribute class initarg) value))
-
- (push initarg createslots)
- (push value createslots)
- )
-
- (setq slots (cdr (cdr slots))))
-
- (apply #'make-instance objclass (nreverse createslots))
-
- ;;(eval inputlist)
- ))
-
-(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
- "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
-A limited number of functions, such as quote, list, and valid object
-constructor functions are considered valid.
-Second, any text properties will be stripped from strings."
- (cond ((consp proposed-value)
- ;; Lists with something in them need special treatment.
- (let* ((slot-idx (- (eieio--slot-name-index class slot)
- (eval-when-compile eieio--object-num-slots)))
- (type (cl--slot-descriptor-type (aref (eieio--class-slots class)
- slot-idx)))
- (classtype (eieio-persistent-slot-type-is-class-p type)))
-
- (cond ((eq (car proposed-value) 'quote)
- (car (cdr proposed-value)))
-
- ;; An empty list sometimes shows up as (list), which is dumb, but
- ;; we need to support it for backward compat.
- ((and (eq (car proposed-value) 'list)
- (= (length proposed-value) 1))
- nil)
-
- ;; List of object constructors.
- ((and (eq (car proposed-value) 'list)
- ;; 2nd item is a list.
- (consp (car (cdr proposed-value)))
- ;; 1st elt of 2nd item is a class name.
- (class-p (car (car (cdr proposed-value))))
- )
-
- ;; Check the value against the input class type.
- ;; If something goes wrong, issue a smart warning
- ;; about how a :type is needed for this to work.
- (unless (and
- ;; Do we have a type?
- (consp classtype) (class-p (car classtype)))
- (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S"
- slot classtype))
-
- ;; We have a predicate, but it doesn't satisfy the predicate?
- (dolist (PV (cdr proposed-value))
- (unless (child-of-class-p (car PV) (car classtype))
- (error "Corrupt object on disk")))
-
- ;; We have a list of objects here. Lets load them
- ;; in.
- (let ((objlist nil))
- (dolist (subobj (cdr proposed-value))
- (push (eieio-persistent-convert-list-to-object subobj)
- 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))))
-
- ((stringp proposed-value)
- ;; Else, check for strings, remove properties.
- (substring-no-properties proposed-value))
-
- (t
- ;; Else, just return whatever the constant was.
- proposed-value))
- )
-
-(defun eieio-persistent-slot-type-is-class-p (type)
- "Return the class referred to in TYPE.
-If no class is referenced there, then return nil."
- (cond ((class-p type)
- ;; If the type is a class, then return it.
- type)
- ((and (eq 'list-of (car-safe type)) (class-p (cadr type)))
- ;; If it is the type of a list of a class, then return that class and
- ;; the type.
- (cons (cadr type) type))
-
- ((and (symbolp type) (get type 'cl-deftype-handler))
- ;; Macro-expand the type according to cl-deftype definitions.
- (eieio-persistent-slot-type-is-class-p
- (funcall (get type 'cl-deftype-handler))))
-
- ;; FIXME: foo-child should not be a valid type!
- ((and (symbolp type) (string-match "-child\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of %S"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -child, then return
- ;; that class. Unfortunately, in EIEIO, typep of just the
- ;; class is the same as if we used -child, so no further work needed.
- (intern-soft (substring (symbol-name type) 0
- (match-beginning 0))))
- ;; FIXME: foo-list should not be a valid type!
- ((and (symbolp type) (string-match "-list\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of (list-of %S)"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -list, then return
- ;; that class and the predicate to use.
- (cons (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))
- type))
-
- ((eq (car-safe type) 'or)
- ;; 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.
- nil)))
+ (let (createslots)
+ ;; If CLS is an eieio autoload object, then we need to
+ ;; load it.
+ (eieio-class-un-autoload cls)
+
+ ;; Earlier versions of `object-write' added a string name for the
+ ;; object, now obsolete.
+ (when (stringp (car slot-list))
+ (setq slot-list (cdr slot-list)))
+
+ (while slot-list
+ (let ((initarg (car slot-list))
+ (value (cadr slot-list)))
+
+ ;; Strip out quotes, list functions, and update object
+ ;; constructors as needed.
+ (setq value (eieio-persistent-fix-value value))
+
+ (push initarg createslots)
+ (push value createslots))
+
+ (setq slot-list (cddr slot-list)))
+ ;; Or call `initialize-instance' directly?
+ (apply #'make-instance cls (nreverse createslots))))
+
+(defun eieio-persistent-fix-value (value)
+ "Handle VALUE as the proposed value of an object slot.
+A limited number of functions, such as quote, list, and valid
+object constructor functions are handled specially. Second, any
+text properties will be stripped from strings."
+ (let (result)
+ (when (consp value)
+ ;; Lists might be quoted, remove that and splice up.
+ (when (eq (car value) 'quote)
+ (setq value (cadr value)))
+ ;; Remove the symbol 'list.
+ (when (eq (car value) 'list)
+ (setq value (cdr value)))
+ ;; Value could have been (list).
+ (when (consp value)
+ (if (class-p (car value))
+ (setq result
+ (eieio-persistent-make-instance (car value) (cdr value))
+ value nil)
+ (while (consp value)
+ (push (eieio-persistent-fix-value (car value)) result)
+ (setq value (cdr value))))))
+ (if (eieio-object-p result)
+ result
+ ;; FIXME: Is this inefficient?
+ (nconc (nreverse result)
+ (if (stringp value)
+ (substring-no-properties value)
+ value)))))
(cl-defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
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 738711c9c8..b0cb17ab01 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
@@ -238,4 +238,62 @@ persistent-with-objs-list-slot
(persist-test-save-and-compare persist-wols)
(delete-file (oref persist-wols file))))
+;;; Test restoration of objects, lists, and strings.
+
+(defclass persistent-with-strings ()
+ ((slot1
+ :initarg :slot1
+ :type string)
+ (slot2
+ :initarg :slot2
+ :type (list-of string))))
+
+(defclass persistent-with-various-strings (eieio-persistent)
+ ((slot1
+ :initarg :slot1
+ :type cons)
+ (slot2
+ :initarg :slot2
+ :type persistent-with-strings)))
+
+(ert-deftest eieio-test-string-restoration ()
+ "Make sure strings are de-propertized upon restore."
+ (let* ((with-strings
+ (make-instance 'persistent-with-strings
+ :slot1
+ (propertize "a string"
+ 'face 'grep-match-face)
+ :slot2
+ (list
+ (propertize "more"
+ 'face 'dired-mark-face)
+ (propertize "strings"
+ 'display "bad"))))
+ (persist
+ (make-instance 'persistent-with-various-strings
+ :slot1
+ (cons 3 (propertize "fruit"
+ 'display "vegetable"))
+ :slot2 with-strings
+ :file (concat default-directory "test-ps6.pt")))
+ restored)
+ (unwind-protect
+ (progn
+ (eieio-persistent-save persist)
+ (setq restored
+ (eieio-persistent-read
+ (oref persist file)
+ 'persistent-with-various-strings))
+ (should-not
+ (or
+ (text-properties-at
+ 0 (cdr (oref restored slot1)))
+ (text-properties-at
+ 0 (oref (oref restored slot2) slot1))
+ (text-properties-at
+ 0 (car (oref (oref restored slot2) slot2)))
+ (text-properties-at
+ 0 (nth 1 (oref (oref restored slot2) slot2))))))
+ (delete-file (oref persist file)))))
+
;;; eieio-test-persist.el ends here
--
2.15.1
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation
2017-12-03 0:10 bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Eric Abrahamsen
@ 2019-06-24 20:28 ` Lars Ingebrigtsen
2020-08-10 14:05 ` Lars Ingebrigtsen
0 siblings, 1 reply; 7+ messages in thread
From: Lars Ingebrigtsen @ 2019-06-24 20:28 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 29541
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> The attached patch is a proposal that would replace the function
> `eieio-persistent-convert-list-to-object' with a generic method
> `eieio-persistent-make-instance'. It also removes all slot validation in
> the read process.
>
> Considerations:
>
> 1. `object-write' is already a method. That means the writing process
> can be overridden and customized, but the reading process can't, which
> removes most of the benefit of being able to override the write. This
> would allow "matching" methods for writing and reading.
This makes sense, and having a method instead of a function here
certainly seems cleaner...
Did anybody with a deeper knowledge of the eieio machinery provide any
feedback? It's a quite large patch...
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation
2019-06-24 20:28 ` Lars Ingebrigtsen
@ 2020-08-10 14:05 ` Lars Ingebrigtsen
2020-08-28 1:40 ` Eric Abrahamsen
2020-08-28 1:41 ` Eric Abrahamsen
0 siblings, 2 replies; 7+ messages in thread
From: Lars Ingebrigtsen @ 2020-08-10 14:05 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 29541
Lars Ingebrigtsen <larsi@gnus.org> writes:
>> 1. `object-write' is already a method. That means the writing process
>> can be overridden and customized, but the reading process can't, which
>> removes most of the benefit of being able to override the write. This
>> would allow "matching" methods for writing and reading.
>
> This makes sense, and having a method instead of a function here
> certainly seems cleaner...
>
> Did anybody with a deeper knowledge of the eieio machinery provide any
> feedback? It's a quite large patch...
There wasn't any feedback here, so I think that you should go ahead and
apply the patch, Eric. I think it makes sense conceptually, at least.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation
2020-08-10 14:05 ` Lars Ingebrigtsen
@ 2020-08-28 1:40 ` Eric Abrahamsen
2020-08-28 1:41 ` Eric Abrahamsen
1 sibling, 0 replies; 7+ messages in thread
From: Eric Abrahamsen @ 2020-08-28 1:40 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 29541
[-- Attachment #1: Type: text/plain, Size: 1006 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Lars Ingebrigtsen <larsi@gnus.org> writes:
>
>>> 1. `object-write' is already a method. That means the writing process
>>> can be overridden and customized, but the reading process can't, which
>>> removes most of the benefit of being able to override the write. This
>>> would allow "matching" methods for writing and reading.
>>
>> This makes sense, and having a method instead of a function here
>> certainly seems cleaner...
>>
>> Did anybody with a deeper knowledge of the eieio machinery provide any
>> feedback? It's a quite large patch...
>
> There wasn't any feedback here, so I think that you should go ahead and
> apply the patch, Eric. I think it makes sense conceptually, at least.
This was quite a while ago, and the original patch no longer applies.
I've done up the same changes as two separate patches: one removing
extra validation, and the other creating a generic function for
constructing eieio-persistent objects. All the tests pass.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-New-eieio-persistent-make-instance-generic-function.patch --]
[-- Type: text/x-patch, Size: 5583 bytes --]
From aef73b345dde80eaed4569afc254e36af544ca87 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Thu, 27 Aug 2020 17:58:03 -0700
Subject: [PATCH 2/2] New eieio-persistent-make-instance generic function
This allows override of the read process for eieio-persistent objects,
providing the possibility of matching read/write customization for
eieio-persistent subclasses.
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-make-instance): New
generic function for constructing instances from object data written
to disk. Previously known as eieio-persistent-convert-list-to-object.
---
lisp/emacs-lisp/eieio-base.el | 80 +++++++++++++++++------------------
1 file changed, 39 insertions(+), 41 deletions(-)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index f09d1997ee..39ad30afc5 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -252,44 +252,41 @@ eieio-persistent-read
(error
"Invalid object: %s is not an object of class %s nor a subclass"
(car ret) class))
- (setq ret (eieio-persistent-convert-list-to-object ret))
+ (setq ret (eieio-persistent-make-instance (car ret) (cdr ret)))
(oset ret file filename))
(kill-buffer " *tmp eieio read*"))
ret))
-(defun eieio-persistent-convert-list-to-object (inputlist)
- "Convert the INPUTLIST, representing object creation to an object.
-While it is possible to just `eval' the INPUTLIST, this code instead
-validates the existing list, and explicitly creates objects instead of
-calling eval. This avoids the possibility of accidentally running
-malicious code.
-
-Note: This function recurses when a slot of :type of some object is
-identified, and needing more object creation."
- (let ((objclass (nth 0 inputlist))
- ;; Earlier versions of `object-write' added a string name for
- ;; the object, now obsolete.
- (slots (nthcdr
- (if (stringp (nth 1 inputlist)) 2 1)
- inputlist))
- (createslots nil))
- ;; If OBJCLASS is an eieio autoload object, then we need to
- ;; load it (we don't need the return value).
- (eieio--full-class-object objclass)
- (while slots
- (let ((initarg (car slots))
- (value (car (cdr slots))))
-
- ;; Strip out quotes, list functions, and update object
- ;; constructors as needed.
- (setq value (eieio-persistent-fix-value value))
-
- (push initarg createslots)
- (push value createslots))
-
- (setq slots (cdr (cdr slots))))
-
- (apply #'make-instance objclass (nreverse createslots))))
+(cl-defgeneric eieio-persistent-make-instance (objclass inputlist)
+ "Convert INPUTLIST, representing slot values, to an instance of OBJCLASS.
+Clean slot values, and possibly recursively create additional
+objects found there."
+ (:method
+ ((objclass (subclass eieio-default-superclass)) inputlist)
+
+ (let ((slots (if (stringp (car inputlist))
+ ;; Earlier versions of `object-write' added a
+ ;; string name for the object, now obsolete.
+ (cdr inputlist)
+ inputlist))
+ (createslots nil))
+ ;; If OBJCLASS is an eieio autoload object, then we need to
+ ;; load it (we don't need the return value).
+ (eieio--full-class-object objclass)
+ (while slots
+ (let ((initarg (car slots))
+ (value (car (cdr slots))))
+
+ ;; Strip out quotes, list functions, and update object
+ ;; constructors as needed.
+ (setq value (eieio-persistent-fix-value value))
+
+ (push initarg createslots)
+ (push value createslots))
+
+ (setq slots (cdr (cdr slots))))
+
+ (apply #'make-instance objclass (nreverse createslots)))))
(defun eieio-persistent-fix-value (proposed-value)
"Fix PROPOSED-VALUE.
@@ -323,7 +320,8 @@ eieio-persistent-fix-value
;; in.
(let ((objlist nil))
(dolist (subobj (cdr proposed-value))
- (push (eieio-persistent-convert-list-to-object subobj)
+ (push (eieio-persistent-make-instance
+ (car subobj) (cdr subobj))
objlist))
;; return the list of objects ... reversed.
(nreverse objlist)))
@@ -331,8 +329,8 @@ eieio-persistent-fix-value
;; saved here. Recurse and evaluate that
;; sub-object.
((class-p (car proposed-value))
- (eieio-persistent-convert-list-to-object
- proposed-value))
+ (eieio-persistent-make-instance
+ (car proposed-value) (cdr proposed-value)))
(t
proposed-value)))
;; For hash-tables and vectors, the top-level `read' will not
@@ -345,8 +343,8 @@ eieio-persistent-fix-value
(lambda (key value)
(setf (gethash key proposed-value)
(if (class-p (car-safe value))
- (eieio-persistent-convert-list-to-object
- value)
+ (eieio-persistent-make-instance
+ (car value) (cdr value))
(eieio-persistent-fix-value value))))
proposed-value)
proposed-value)
@@ -356,8 +354,8 @@ eieio-persistent-fix-value
(let ((val (aref proposed-value i)))
(aset proposed-value i
(if (class-p (car-safe val))
- (eieio-persistent-convert-list-to-object
- val)
+ (eieio-persistent-make-instance
+ (car val) (cdr val))
(eieio-persistent-fix-value val)))))
proposed-value)
--
2.28.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Remove-redundant-slot-validation-in-eieio-persistent.patch --]
[-- Type: text/x-patch, Size: 11206 bytes --]
From baa5f99fd6712896803722ce36623765446b901b Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Thu, 27 Aug 2020 17:17:19 -0700
Subject: [PATCH 1/2] Remove redundant slot validation in eieio-persistent-read
Actual object creation (in `make-instance') will later run all slot
values through cl-typep, which does a better job of validation. This
validation is redundant, and slows the read process down.
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-fix-value): Rename
from `eieio-persistent-validate/fix-slot-value', as we no longer
validate, and we don't care about the slot definition.
(eieio-persistent-slot-type-is-class-p): Delete function.
(eieio-persistent-convert-list-to-object): Still call
`eieio--full-class-object', to trigger an autoload if necessary, but
discard the return value.
---
lisp/emacs-lisp/eieio-base.el | 211 ++++++++++------------------------
1 file changed, 63 insertions(+), 148 deletions(-)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 2cb1f614ce..f09d1997ee 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -266,105 +266,75 @@ eieio-persistent-convert-list-to-object
Note: This function recurses when a slot of :type of some object is
identified, and needing more object creation."
- (let* ((objclass (nth 0 inputlist))
- ;; Earlier versions of `object-write' added a string name for
- ;; the object, now obsolete.
- (slots (nthcdr
- (if (stringp (nth 1 inputlist)) 2 1)
- inputlist))
- (createslots nil)
- (class
- (progn
- ;; If OBJCLASS is an eieio autoload object, then we need to
- ;; load it.
- (eieio--full-class-object objclass))))
-
+ (let ((objclass (nth 0 inputlist))
+ ;; Earlier versions of `object-write' added a string name for
+ ;; the object, now obsolete.
+ (slots (nthcdr
+ (if (stringp (nth 1 inputlist)) 2 1)
+ inputlist))
+ (createslots nil))
+ ;; If OBJCLASS is an eieio autoload object, then we need to
+ ;; load it (we don't need the return value).
+ (eieio--full-class-object objclass)
(while slots
(let ((initarg (car slots))
(value (car (cdr slots))))
- ;; Make sure that the value proposed for SLOT is valid.
- ;; In addition, strip out quotes, list functions, and update
- ;; object constructors as needed.
- (setq value (eieio-persistent-validate/fix-slot-value
- class (eieio--initarg-to-attribute class initarg) value))
+ ;; Strip out quotes, list functions, and update object
+ ;; constructors as needed.
+ (setq value (eieio-persistent-fix-value value))
(push initarg createslots)
- (push value createslots)
- )
+ (push value createslots))
(setq slots (cdr (cdr slots))))
- (apply #'make-instance objclass (nreverse createslots))
+ (apply #'make-instance objclass (nreverse createslots))))
- ;;(eval inputlist)
- ))
+(defun eieio-persistent-fix-value (proposed-value)
+ "Fix PROPOSED-VALUE.
+Remove leading quotes from lists, and the symbol `list' from the
+head of lists. Explicitly construct any objects found, and strip
+any text properties from string values.
-(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
- "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
-A limited number of functions, such as quote, list, and valid object
-constructor functions are considered valid.
-Second, any text properties will be stripped from strings."
+This function will descend into the contents of lists, hash
+tables, and vectors."
(cond ((consp proposed-value)
;; Lists with something in them need special treatment.
- (let* ((slot-idx (- (eieio--slot-name-index class slot)
- (eval-when-compile eieio--object-num-slots)))
- (type (cl--slot-descriptor-type (aref (eieio--class-slots class)
- slot-idx)))
- (classtype (eieio-persistent-slot-type-is-class-p type)))
-
- (cond ((eq (car proposed-value) 'quote)
- (car (cdr proposed-value)))
-
- ;; An empty list sometimes shows up as (list), which is dumb, but
- ;; we need to support it for backward compat.
- ((and (eq (car proposed-value) 'list)
- (= (length proposed-value) 1))
- nil)
-
- ;; List of object constructors.
- ((and (eq (car proposed-value) 'list)
- ;; 2nd item is a list.
- (consp (car (cdr proposed-value)))
- ;; 1st elt of 2nd item is a class name.
- (class-p (car (car (cdr proposed-value))))
- )
-
- ;; Check the value against the input class type.
- ;; If something goes wrong, issue a smart warning
- ;; about how a :type is needed for this to work.
- (unless (and
- ;; Do we have a type?
- (consp classtype) (class-p (car classtype)))
- (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S"
- slot classtype))
-
- ;; We have a predicate, but it doesn't satisfy the predicate?
- (dolist (PV (cdr proposed-value))
- (unless (child-of-class-p (car PV) (car classtype))
- (error "Invalid object: slot member %s does not match class %s"
- (car PV) (car classtype))))
-
- ;; We have a list of objects here. Lets load them
- ;; in.
- (let ((objlist nil))
- (dolist (subobj (cdr proposed-value))
- (push (eieio-persistent-convert-list-to-object subobj)
- 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))
- (if (listp classtype) classtype (list classtype))))
- (eieio-persistent-convert-list-to-object
- proposed-value))
- (t
- proposed-value))))
+ (cond ((eq (car proposed-value) 'quote)
+ (while (eq (car-safe proposed-value) 'quote)
+ (setq proposed-value (car (cdr proposed-value))))
+ proposed-value)
+
+ ;; An empty list sometimes shows up as (list), which is dumb, but
+ ;; we need to support it for backward compar.
+ ((and (eq (car proposed-value) 'list)
+ (= (length proposed-value) 1))
+ nil)
+
+ ;; List of object constructors.
+ ((and (eq (car proposed-value) 'list)
+ ;; 2nd item is a list.
+ (consp (car (cdr proposed-value)))
+ ;; 1st elt of 2nd item is a class name.
+ (class-p (car (car (cdr proposed-value)))))
+
+ ;; We have a list of objects here. Lets load them
+ ;; in.
+ (let ((objlist nil))
+ (dolist (subobj (cdr proposed-value))
+ (push (eieio-persistent-convert-list-to-object subobj)
+ 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.
+ ((class-p (car proposed-value))
+ (eieio-persistent-convert-list-to-object
+ proposed-value))
+ (t
+ proposed-value)))
;; For hash-tables and vectors, the top-level `read' will not
;; "look inside" member values, so we need to do that
;; explicitly. Because `eieio-override-prin1' is recursive in
@@ -377,8 +347,7 @@ eieio-persistent-validate/fix-slot-value
(if (class-p (car-safe value))
(eieio-persistent-convert-list-to-object
value)
- (eieio-persistent-validate/fix-slot-value
- class slot value))))
+ (eieio-persistent-fix-value value))))
proposed-value)
proposed-value)
@@ -389,70 +358,16 @@ eieio-persistent-validate/fix-slot-value
(if (class-p (car-safe val))
(eieio-persistent-convert-list-to-object
val)
- (eieio-persistent-validate/fix-slot-value
- class slot val)))))
+ (eieio-persistent-fix-value val)))))
proposed-value)
- ((stringp proposed-value)
- ;; Else, check for strings, remove properties.
- (substring-no-properties proposed-value))
-
- (t
- ;; Else, just return whatever the constant was.
- proposed-value))
- )
-
-(defun eieio-persistent-slot-type-is-class-p (type)
- "Return the class referred to in TYPE.
-If no class is referenced there, then return nil."
- (cond ((class-p type)
- ;; If the type is a class, then return it.
- type)
- ((and (eq 'list-of (car-safe type)) (class-p (cadr type)))
- ;; If it is the type of a list of a class, then return that class and
- ;; the type.
- (cons (cadr type) type))
-
- ((and (symbolp type) (get type 'cl-deftype-handler))
- ;; Macro-expand the type according to cl-deftype definitions.
- (eieio-persistent-slot-type-is-class-p
- (funcall (get type 'cl-deftype-handler))))
-
- ;; FIXME: foo-child should not be a valid type!
- ((and (symbolp type) (string-match "-child\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of %S"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -child, then return
- ;; that class. Unfortunately, in EIEIO, typep of just the
- ;; class is the same as if we used -child, so no further work needed.
- (intern-soft (substring (symbol-name type) 0
- (match-beginning 0))))
- ;; FIXME: foo-list should not be a valid type!
- ((and (symbolp type) (string-match "-list\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of (list-of %S)"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -list, then return
- ;; that class and the predicate to use.
- (cons (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))
- type))
-
- ((eq (car-safe type) 'or)
- ;; 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)))
+ ((stringp proposed-value)
+ ;; Else, check for strings, remove properties.
+ (substring-no-properties proposed-value))
(t
- ;; No match, not a class.
- nil)))
+ ;; Else, just return whatever the constant was.
+ proposed-value)))
(cl-defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
--
2.28.0
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation
2020-08-10 14:05 ` Lars Ingebrigtsen
2020-08-28 1:40 ` Eric Abrahamsen
@ 2020-08-28 1:41 ` Eric Abrahamsen
2020-08-28 14:18 ` Lars Ingebrigtsen
1 sibling, 1 reply; 7+ messages in thread
From: Eric Abrahamsen @ 2020-08-28 1:41 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 29541
[-- Attachment #1: Type: text/plain, Size: 1006 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Lars Ingebrigtsen <larsi@gnus.org> writes:
>
>>> 1. `object-write' is already a method. That means the writing process
>>> can be overridden and customized, but the reading process can't, which
>>> removes most of the benefit of being able to override the write. This
>>> would allow "matching" methods for writing and reading.
>>
>> This makes sense, and having a method instead of a function here
>> certainly seems cleaner...
>>
>> Did anybody with a deeper knowledge of the eieio machinery provide any
>> feedback? It's a quite large patch...
>
> There wasn't any feedback here, so I think that you should go ahead and
> apply the patch, Eric. I think it makes sense conceptually, at least.
This was quite a while ago, and the original patch no longer applies.
I've done up the same changes as two separate patches: one removing
extra validation, and the other creating a generic function for
constructing eieio-persistent objects. All the tests pass.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-New-eieio-persistent-make-instance-generic-function.patch --]
[-- Type: text/x-patch, Size: 5583 bytes --]
From aef73b345dde80eaed4569afc254e36af544ca87 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Thu, 27 Aug 2020 17:58:03 -0700
Subject: [PATCH 2/2] New eieio-persistent-make-instance generic function
This allows override of the read process for eieio-persistent objects,
providing the possibility of matching read/write customization for
eieio-persistent subclasses.
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-make-instance): New
generic function for constructing instances from object data written
to disk. Previously known as eieio-persistent-convert-list-to-object.
---
lisp/emacs-lisp/eieio-base.el | 80 +++++++++++++++++------------------
1 file changed, 39 insertions(+), 41 deletions(-)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index f09d1997ee..39ad30afc5 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -252,44 +252,41 @@ eieio-persistent-read
(error
"Invalid object: %s is not an object of class %s nor a subclass"
(car ret) class))
- (setq ret (eieio-persistent-convert-list-to-object ret))
+ (setq ret (eieio-persistent-make-instance (car ret) (cdr ret)))
(oset ret file filename))
(kill-buffer " *tmp eieio read*"))
ret))
-(defun eieio-persistent-convert-list-to-object (inputlist)
- "Convert the INPUTLIST, representing object creation to an object.
-While it is possible to just `eval' the INPUTLIST, this code instead
-validates the existing list, and explicitly creates objects instead of
-calling eval. This avoids the possibility of accidentally running
-malicious code.
-
-Note: This function recurses when a slot of :type of some object is
-identified, and needing more object creation."
- (let ((objclass (nth 0 inputlist))
- ;; Earlier versions of `object-write' added a string name for
- ;; the object, now obsolete.
- (slots (nthcdr
- (if (stringp (nth 1 inputlist)) 2 1)
- inputlist))
- (createslots nil))
- ;; If OBJCLASS is an eieio autoload object, then we need to
- ;; load it (we don't need the return value).
- (eieio--full-class-object objclass)
- (while slots
- (let ((initarg (car slots))
- (value (car (cdr slots))))
-
- ;; Strip out quotes, list functions, and update object
- ;; constructors as needed.
- (setq value (eieio-persistent-fix-value value))
-
- (push initarg createslots)
- (push value createslots))
-
- (setq slots (cdr (cdr slots))))
-
- (apply #'make-instance objclass (nreverse createslots))))
+(cl-defgeneric eieio-persistent-make-instance (objclass inputlist)
+ "Convert INPUTLIST, representing slot values, to an instance of OBJCLASS.
+Clean slot values, and possibly recursively create additional
+objects found there."
+ (:method
+ ((objclass (subclass eieio-default-superclass)) inputlist)
+
+ (let ((slots (if (stringp (car inputlist))
+ ;; Earlier versions of `object-write' added a
+ ;; string name for the object, now obsolete.
+ (cdr inputlist)
+ inputlist))
+ (createslots nil))
+ ;; If OBJCLASS is an eieio autoload object, then we need to
+ ;; load it (we don't need the return value).
+ (eieio--full-class-object objclass)
+ (while slots
+ (let ((initarg (car slots))
+ (value (car (cdr slots))))
+
+ ;; Strip out quotes, list functions, and update object
+ ;; constructors as needed.
+ (setq value (eieio-persistent-fix-value value))
+
+ (push initarg createslots)
+ (push value createslots))
+
+ (setq slots (cdr (cdr slots))))
+
+ (apply #'make-instance objclass (nreverse createslots)))))
(defun eieio-persistent-fix-value (proposed-value)
"Fix PROPOSED-VALUE.
@@ -323,7 +320,8 @@ eieio-persistent-fix-value
;; in.
(let ((objlist nil))
(dolist (subobj (cdr proposed-value))
- (push (eieio-persistent-convert-list-to-object subobj)
+ (push (eieio-persistent-make-instance
+ (car subobj) (cdr subobj))
objlist))
;; return the list of objects ... reversed.
(nreverse objlist)))
@@ -331,8 +329,8 @@ eieio-persistent-fix-value
;; saved here. Recurse and evaluate that
;; sub-object.
((class-p (car proposed-value))
- (eieio-persistent-convert-list-to-object
- proposed-value))
+ (eieio-persistent-make-instance
+ (car proposed-value) (cdr proposed-value)))
(t
proposed-value)))
;; For hash-tables and vectors, the top-level `read' will not
@@ -345,8 +343,8 @@ eieio-persistent-fix-value
(lambda (key value)
(setf (gethash key proposed-value)
(if (class-p (car-safe value))
- (eieio-persistent-convert-list-to-object
- value)
+ (eieio-persistent-make-instance
+ (car value) (cdr value))
(eieio-persistent-fix-value value))))
proposed-value)
proposed-value)
@@ -356,8 +354,8 @@ eieio-persistent-fix-value
(let ((val (aref proposed-value i)))
(aset proposed-value i
(if (class-p (car-safe val))
- (eieio-persistent-convert-list-to-object
- val)
+ (eieio-persistent-make-instance
+ (car val) (cdr val))
(eieio-persistent-fix-value val)))))
proposed-value)
--
2.28.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Remove-redundant-slot-validation-in-eieio-persistent.patch --]
[-- Type: text/x-patch, Size: 11206 bytes --]
From baa5f99fd6712896803722ce36623765446b901b Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Thu, 27 Aug 2020 17:17:19 -0700
Subject: [PATCH 1/2] Remove redundant slot validation in eieio-persistent-read
Actual object creation (in `make-instance') will later run all slot
values through cl-typep, which does a better job of validation. This
validation is redundant, and slows the read process down.
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-fix-value): Rename
from `eieio-persistent-validate/fix-slot-value', as we no longer
validate, and we don't care about the slot definition.
(eieio-persistent-slot-type-is-class-p): Delete function.
(eieio-persistent-convert-list-to-object): Still call
`eieio--full-class-object', to trigger an autoload if necessary, but
discard the return value.
---
lisp/emacs-lisp/eieio-base.el | 211 ++++++++++------------------------
1 file changed, 63 insertions(+), 148 deletions(-)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 2cb1f614ce..f09d1997ee 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -266,105 +266,75 @@ eieio-persistent-convert-list-to-object
Note: This function recurses when a slot of :type of some object is
identified, and needing more object creation."
- (let* ((objclass (nth 0 inputlist))
- ;; Earlier versions of `object-write' added a string name for
- ;; the object, now obsolete.
- (slots (nthcdr
- (if (stringp (nth 1 inputlist)) 2 1)
- inputlist))
- (createslots nil)
- (class
- (progn
- ;; If OBJCLASS is an eieio autoload object, then we need to
- ;; load it.
- (eieio--full-class-object objclass))))
-
+ (let ((objclass (nth 0 inputlist))
+ ;; Earlier versions of `object-write' added a string name for
+ ;; the object, now obsolete.
+ (slots (nthcdr
+ (if (stringp (nth 1 inputlist)) 2 1)
+ inputlist))
+ (createslots nil))
+ ;; If OBJCLASS is an eieio autoload object, then we need to
+ ;; load it (we don't need the return value).
+ (eieio--full-class-object objclass)
(while slots
(let ((initarg (car slots))
(value (car (cdr slots))))
- ;; Make sure that the value proposed for SLOT is valid.
- ;; In addition, strip out quotes, list functions, and update
- ;; object constructors as needed.
- (setq value (eieio-persistent-validate/fix-slot-value
- class (eieio--initarg-to-attribute class initarg) value))
+ ;; Strip out quotes, list functions, and update object
+ ;; constructors as needed.
+ (setq value (eieio-persistent-fix-value value))
(push initarg createslots)
- (push value createslots)
- )
+ (push value createslots))
(setq slots (cdr (cdr slots))))
- (apply #'make-instance objclass (nreverse createslots))
+ (apply #'make-instance objclass (nreverse createslots))))
- ;;(eval inputlist)
- ))
+(defun eieio-persistent-fix-value (proposed-value)
+ "Fix PROPOSED-VALUE.
+Remove leading quotes from lists, and the symbol `list' from the
+head of lists. Explicitly construct any objects found, and strip
+any text properties from string values.
-(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
- "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
-A limited number of functions, such as quote, list, and valid object
-constructor functions are considered valid.
-Second, any text properties will be stripped from strings."
+This function will descend into the contents of lists, hash
+tables, and vectors."
(cond ((consp proposed-value)
;; Lists with something in them need special treatment.
- (let* ((slot-idx (- (eieio--slot-name-index class slot)
- (eval-when-compile eieio--object-num-slots)))
- (type (cl--slot-descriptor-type (aref (eieio--class-slots class)
- slot-idx)))
- (classtype (eieio-persistent-slot-type-is-class-p type)))
-
- (cond ((eq (car proposed-value) 'quote)
- (car (cdr proposed-value)))
-
- ;; An empty list sometimes shows up as (list), which is dumb, but
- ;; we need to support it for backward compat.
- ((and (eq (car proposed-value) 'list)
- (= (length proposed-value) 1))
- nil)
-
- ;; List of object constructors.
- ((and (eq (car proposed-value) 'list)
- ;; 2nd item is a list.
- (consp (car (cdr proposed-value)))
- ;; 1st elt of 2nd item is a class name.
- (class-p (car (car (cdr proposed-value))))
- )
-
- ;; Check the value against the input class type.
- ;; If something goes wrong, issue a smart warning
- ;; about how a :type is needed for this to work.
- (unless (and
- ;; Do we have a type?
- (consp classtype) (class-p (car classtype)))
- (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S"
- slot classtype))
-
- ;; We have a predicate, but it doesn't satisfy the predicate?
- (dolist (PV (cdr proposed-value))
- (unless (child-of-class-p (car PV) (car classtype))
- (error "Invalid object: slot member %s does not match class %s"
- (car PV) (car classtype))))
-
- ;; We have a list of objects here. Lets load them
- ;; in.
- (let ((objlist nil))
- (dolist (subobj (cdr proposed-value))
- (push (eieio-persistent-convert-list-to-object subobj)
- 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))
- (if (listp classtype) classtype (list classtype))))
- (eieio-persistent-convert-list-to-object
- proposed-value))
- (t
- proposed-value))))
+ (cond ((eq (car proposed-value) 'quote)
+ (while (eq (car-safe proposed-value) 'quote)
+ (setq proposed-value (car (cdr proposed-value))))
+ proposed-value)
+
+ ;; An empty list sometimes shows up as (list), which is dumb, but
+ ;; we need to support it for backward compar.
+ ((and (eq (car proposed-value) 'list)
+ (= (length proposed-value) 1))
+ nil)
+
+ ;; List of object constructors.
+ ((and (eq (car proposed-value) 'list)
+ ;; 2nd item is a list.
+ (consp (car (cdr proposed-value)))
+ ;; 1st elt of 2nd item is a class name.
+ (class-p (car (car (cdr proposed-value)))))
+
+ ;; We have a list of objects here. Lets load them
+ ;; in.
+ (let ((objlist nil))
+ (dolist (subobj (cdr proposed-value))
+ (push (eieio-persistent-convert-list-to-object subobj)
+ 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.
+ ((class-p (car proposed-value))
+ (eieio-persistent-convert-list-to-object
+ proposed-value))
+ (t
+ proposed-value)))
;; For hash-tables and vectors, the top-level `read' will not
;; "look inside" member values, so we need to do that
;; explicitly. Because `eieio-override-prin1' is recursive in
@@ -377,8 +347,7 @@ eieio-persistent-validate/fix-slot-value
(if (class-p (car-safe value))
(eieio-persistent-convert-list-to-object
value)
- (eieio-persistent-validate/fix-slot-value
- class slot value))))
+ (eieio-persistent-fix-value value))))
proposed-value)
proposed-value)
@@ -389,70 +358,16 @@ eieio-persistent-validate/fix-slot-value
(if (class-p (car-safe val))
(eieio-persistent-convert-list-to-object
val)
- (eieio-persistent-validate/fix-slot-value
- class slot val)))))
+ (eieio-persistent-fix-value val)))))
proposed-value)
- ((stringp proposed-value)
- ;; Else, check for strings, remove properties.
- (substring-no-properties proposed-value))
-
- (t
- ;; Else, just return whatever the constant was.
- proposed-value))
- )
-
-(defun eieio-persistent-slot-type-is-class-p (type)
- "Return the class referred to in TYPE.
-If no class is referenced there, then return nil."
- (cond ((class-p type)
- ;; If the type is a class, then return it.
- type)
- ((and (eq 'list-of (car-safe type)) (class-p (cadr type)))
- ;; If it is the type of a list of a class, then return that class and
- ;; the type.
- (cons (cadr type) type))
-
- ((and (symbolp type) (get type 'cl-deftype-handler))
- ;; Macro-expand the type according to cl-deftype definitions.
- (eieio-persistent-slot-type-is-class-p
- (funcall (get type 'cl-deftype-handler))))
-
- ;; FIXME: foo-child should not be a valid type!
- ((and (symbolp type) (string-match "-child\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of %S"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -child, then return
- ;; that class. Unfortunately, in EIEIO, typep of just the
- ;; class is the same as if we used -child, so no further work needed.
- (intern-soft (substring (symbol-name type) 0
- (match-beginning 0))))
- ;; FIXME: foo-list should not be a valid type!
- ((and (symbolp type) (string-match "-list\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of (list-of %S)"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -list, then return
- ;; that class and the predicate to use.
- (cons (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))
- type))
-
- ((eq (car-safe type) 'or)
- ;; 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)))
+ ((stringp proposed-value)
+ ;; Else, check for strings, remove properties.
+ (substring-no-properties proposed-value))
(t
- ;; No match, not a class.
- nil)))
+ ;; Else, just return whatever the constant was.
+ proposed-value)))
(cl-defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
--
2.28.0
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation
2020-08-28 1:41 ` Eric Abrahamsen
@ 2020-08-28 14:18 ` Lars Ingebrigtsen
2020-08-28 15:24 ` Eric Abrahamsen
0 siblings, 1 reply; 7+ messages in thread
From: Lars Ingebrigtsen @ 2020-08-28 14:18 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 29541
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> This was quite a while ago, and the original patch no longer applies.
> I've done up the same changes as two separate patches: one removing
> extra validation, and the other creating a generic function for
> constructing eieio-persistent objects. All the tests pass.
I've just skimmed the code, but it looks good to me. I'd say just apply
it and then see whether there is any fallout (but I don't expect there
to be).
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation
2020-08-28 14:18 ` Lars Ingebrigtsen
@ 2020-08-28 15:24 ` Eric Abrahamsen
0 siblings, 0 replies; 7+ messages in thread
From: Eric Abrahamsen @ 2020-08-28 15:24 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 29541, 29541-done
On 08/28/20 16:18 PM, Lars Ingebrigtsen wrote:
> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> This was quite a while ago, and the original patch no longer applies.
>> I've done up the same changes as two separate patches: one removing
>> extra validation, and the other creating a generic function for
>> constructing eieio-persistent objects. All the tests pass.
>
> I've just skimmed the code, but it looks good to me. I'd say just apply
> it and then see whether there is any fallout (but I don't expect there
> to be).
I've also used this with the gnus registry and EBDB, which should
exercise it fairly well. I'll push now.
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2020-08-28 15:24 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-12-03 0:10 bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Eric Abrahamsen
2019-06-24 20:28 ` Lars Ingebrigtsen
2020-08-10 14:05 ` Lars Ingebrigtsen
2020-08-28 1:40 ` Eric Abrahamsen
2020-08-28 1:41 ` Eric Abrahamsen
2020-08-28 14:18 ` Lars Ingebrigtsen
2020-08-28 15:24 ` Eric Abrahamsen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).