From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Eric Abrahamsen Newsgroups: gmane.emacs.bugs Subject: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Date: Thu, 27 Aug 2020 18:41:29 -0700 Message-ID: <87zh6feed2.fsf@ericabrahamsen.net> References: <87shcsisdc.fsf@ericabrahamsen.net> <875z9q38bz.fsf@gnus.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="7254"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: 29541@debbugs.gnu.org To: Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Aug 28 03:42:10 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kBTP7-0001nZ-FR for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 28 Aug 2020 03:42:09 +0200 Original-Received: from localhost ([::1]:41446 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kBTP6-0001Ev-IV for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 27 Aug 2020 21:42:08 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:46896) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kBTP0-0001Ei-62 for bug-gnu-emacs@gnu.org; Thu, 27 Aug 2020 21:42:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:33004) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kBTOz-00024h-TU for bug-gnu-emacs@gnu.org; Thu, 27 Aug 2020 21:42:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kBTOz-0000MJ-Rf for bug-gnu-emacs@gnu.org; Thu, 27 Aug 2020 21:42:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Eric Abrahamsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 28 Aug 2020 01:42:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 29541 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 29541-submit@debbugs.gnu.org id=B29541.15985788991346 (code B ref 29541); Fri, 28 Aug 2020 01:42:01 +0000 Original-Received: (at 29541) by debbugs.gnu.org; 28 Aug 2020 01:41:39 +0000 Original-Received: from localhost ([127.0.0.1]:44550 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBTOc-0000Ld-PT for submit@debbugs.gnu.org; Thu, 27 Aug 2020 21:41:39 -0400 Original-Received: from ericabrahamsen.net ([52.70.2.18]:52134 helo=mail.ericabrahamsen.net) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBTOb-0000LR-7Y for 29541@debbugs.gnu.org; Thu, 27 Aug 2020 21:41:38 -0400 Original-Received: from localhost (c-73-254-86-141.hsd1.wa.comcast.net [73.254.86.141]) (Authenticated sender: eric@ericabrahamsen.net) by mail.ericabrahamsen.net (Postfix) with ESMTPSA id 22FCAFA02E; Fri, 28 Aug 2020 01:41:31 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ericabrahamsen.net; s=mail; t=1598578891; bh=igMxgmZl4l8Zw8IqlaQ8vVIx/EBy5ine5EwLUNi2t9w=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=WL+Mna8KDJ5bJpvQjOPuySssjIFc/pdZMfB4Ntun/Zsk81pGWz+khfWbZirwY0iMC B3G4W39G71VbJKRcO3sbetIfhGvDJMw7aSChQZ5glXeNL3mJ/DHbkOIq9joMWgr7xo xRsisJZiyD9BC35SmjTUeP3tnC0wexNrcW8mZBxk= In-Reply-To: <875z9q38bz.fsf@gnus.org> (Lars Ingebrigtsen's message of "Mon, 10 Aug 2020 16:05:04 +0200") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:186578 Archived-At: --=-=-= Content-Type: text/plain Lars Ingebrigtsen writes: > Lars Ingebrigtsen 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-New-eieio-persistent-make-instance-generic-function.patch >From aef73b345dde80eaed4569afc254e36af544ca87 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Remove-redundant-slot-validation-in-eieio-persistent.patch >From baa5f99fd6712896803722ce36623765446b901b Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen 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 --=-=-=--