From unknown Mon Aug 18 11:19:09 2025 X-Loop: help-debbugs@gnu.org Subject: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Resent-From: Eric Abrahamsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 03 Dec 2017 00:13:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 29541 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: 29541@debbugs.gnu.org X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.151225994422901 (code B ref -1); Sun, 03 Dec 2017 00:13:02 +0000 Received: (at submit) by debbugs.gnu.org; 3 Dec 2017 00:12:24 +0000 Received: from localhost ([127.0.0.1]:42283 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eLHtQ-0005xH-8n for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:12:24 -0500 Received: from eggs.gnu.org ([208.118.235.92]:46538) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eLHtN-0005x4-G0 for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:12:22 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eLHtG-0006Jl-2c for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:12:16 -0500 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50,T_DKIM_INVALID, URIBL_BLOCKED autolearn=disabled version=3.3.2 Received: from lists.gnu.org ([2001:4830:134:3::11]:40560) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1eLHtF-0006Jg-U7 for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:12:14 -0500 Received: from eggs.gnu.org ([2001:4830:134:3::10]:37500) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eLHtD-0000x6-Qm for bug-gnu-emacs@gnu.org; Sat, 02 Dec 2017 19:12:13 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eLHt8-0006BM-Pa for bug-gnu-emacs@gnu.org; Sat, 02 Dec 2017 19:12:11 -0500 Received: from mail.ericabrahamsen.net ([50.56.99.223]:37614) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1eLHt8-000666-Ft for bug-gnu-emacs@gnu.org; Sat, 02 Dec 2017 19:12:06 -0500 Received: from localhost (71-212-22-173.tukw.qwest.net [71.212.22.173]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (Client did not present a certificate) (Authenticated sender: eric@ericabrahamsen.net) by mail.ericabrahamsen.net (Postfix) with ESMTPSA id BA297C0241 for ; Sun, 3 Dec 2017 00:11:58 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=mail.ericabrahamsen.net; s=mail; t=1512259919; bh=ulZs6fy7aidvXVW7aVjitJGT0t39J7P72ekD99I2JDw=; h=From:To:Subject:Date:From; b=dS34lvZlmFigOxawThj5tPEU5kQvaom6SV83fqBRJWWrZ1O7N1bJUPNcxz2sbmxUe FiDLIAr7fFBFD8nax6CZZ+CXs6yRmz2dov8qYCfbIVIWllgHBT2uzN4cR1IdWC4Tx+ tLdH8k4CLnGimcI6EwbdFw2dHLoCTyhiIk4Qh7fc= From: Eric Abrahamsen Date: Sat, 02 Dec 2017 16:10:07 -0800 Message-ID: <87shcsisdc.fsf@ericabrahamsen.net> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 2001:4830:134:3::11 X-Spam-Score: -4.1 (----) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -4.1 (----) --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Replace-eieio-persistent-convert-list-to-object-with.patch >From 858b6ca64ad088362800e3ce4d5c0b34114f9b06 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen 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 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sat Dec 02 19:15:00 2017 Received: (at control) by debbugs.gnu.org; 3 Dec 2017 00:15:00 +0000 Received: from localhost ([127.0.0.1]:42289 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eLHvw-00061L-1R for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:15:00 -0500 Received: from mail.ericabrahamsen.net ([50.56.99.223]:44465) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eLHvv-00061D-1a for control@debbugs.gnu.org; Sat, 02 Dec 2017 19:14:59 -0500 Received: from localhost (71-212-22-173.tukw.qwest.net [71.212.22.173]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (Client did not present a certificate) (Authenticated sender: eric@ericabrahamsen.net) by mail.ericabrahamsen.net (Postfix) with ESMTPSA id 42D2EC0241 for ; Sun, 3 Dec 2017 00:14:58 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=mail.ericabrahamsen.net; s=mail; t=1512260098; bh=ir5DT89SgRfGvfNPmc5samq0OJLdugWgVFDrzbndf7I=; h=From:To:Subject:Date:From; b=V0s41gdMm8rm/UbjfmFW+6scTUaY3yVhSiCAo07KsHyn9bYC6QMDvPoEAkD+qgfVl WFcIeqyMsAeE5gXNcmkqcvR0M4E03/1hzMUXtkX5EsAuaf85q15JYT7Qf5r1w0lUQU JsQg9GwpydIRy3nro2Y2BR+DId/+iK32W5kNhwjM= From: Eric Abrahamsen To: control@debbugs.gnu.org Subject: 29541 Date: Sat, 02 Dec 2017 16:13:07 -0800 Message-ID: <87o9ngis8c.fsf@ericabrahamsen.net> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.3 (--) tags 29541 patch thanks From unknown Mon Aug 18 11:19:09 2025 X-Loop: help-debbugs@gnu.org Subject: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Resent-From: Lars Ingebrigtsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 24 Jun 2019 20:29: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 To: Eric Abrahamsen Cc: 29541@debbugs.gnu.org Received: via spool by 29541-submit@debbugs.gnu.org id=B29541.156140813114055 (code B ref 29541); Mon, 24 Jun 2019 20:29:01 +0000 Received: (at 29541) by debbugs.gnu.org; 24 Jun 2019 20:28:51 +0000 Received: from localhost ([127.0.0.1]:58121 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hfVa6-0003ea-A7 for submit@debbugs.gnu.org; Mon, 24 Jun 2019 16:28:51 -0400 Received: from quimby.gnus.org ([80.91.231.51]:36010) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hfVa3-0003eJ-Ij for 29541@debbugs.gnu.org; Mon, 24 Jun 2019 16:28:48 -0400 Received: from cm-84.212.202.86.getinternet.no ([84.212.202.86] helo=stories) by quimby.gnus.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1hfVa0-0007Mz-JS; Mon, 24 Jun 2019 22:28:46 +0200 From: Lars Ingebrigtsen References: <87shcsisdc.fsf@ericabrahamsen.net> Date: Mon, 24 Jun 2019 22:28:44 +0200 In-Reply-To: <87shcsisdc.fsf@ericabrahamsen.net> (Eric Abrahamsen's message of "Sat, 02 Dec 2017 16:10:07 -0800") Message-ID: User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Eric Abrahamsen 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 valida [...] Content analysis details: (-2.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -1.0 ALL_TRUSTED Passed through trusted hosts only via SMTP -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Eric Abrahamsen 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 From unknown Mon Aug 18 11:19:09 2025 X-Loop: help-debbugs@gnu.org Subject: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Resent-From: Lars Ingebrigtsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 10 Aug 2020 14:06: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 To: Eric Abrahamsen Cc: 29541@debbugs.gnu.org Received: via spool by 29541-submit@debbugs.gnu.org id=B29541.15970683164648 (code B ref 29541); Mon, 10 Aug 2020 14:06:01 +0000 Received: (at 29541) by debbugs.gnu.org; 10 Aug 2020 14:05:16 +0000 Received: from localhost ([127.0.0.1]:37023 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k58QO-0001Cu-6T for submit@debbugs.gnu.org; Mon, 10 Aug 2020 10:05:16 -0400 Received: from quimby.gnus.org ([95.216.78.240]:48612) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k58QM-0001Cf-LA for 29541@debbugs.gnu.org; Mon, 10 Aug 2020 10:05:15 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org; s=20200322; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date: References:Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding: Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender: Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe: List-Subscribe:List-Post:List-Owner:List-Archive; bh=c6O1ER/3mt4BHYkf80Md+qk4sUioFalrrImqvopQtyQ=; b=auReWuLvd4BsCseQqwKhRtMPf3 5he3NxTOD6qTwpCWA4zIMTYOn3TYzbI6B3d01Yv/P9AAYLfZGciJGy8ryO1xWLCUgH5sSUk644ui/ CfX6TZJIr8CO+eFDtjA5CCzCtGESmcPJEPx/vgcV6E7Z5yzuH9NPuKfbCGJwj4LqkkFE=; Received: from cm-84.212.202.86.getinternet.no ([84.212.202.86] helo=xo) by quimby with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1k58QD-0005bW-Kb; Mon, 10 Aug 2020 16:05:08 +0200 From: Lars Ingebrigtsen References: <87shcsisdc.fsf@ericabrahamsen.net> Date: Mon, 10 Aug 2020 16:05:04 +0200 In-Reply-To: (Lars Ingebrigtsen's message of "Mon, 24 Jun 2019 22:28:44 +0200") Message-ID: <875z9q38bz.fsf@gnus.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: 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 overr [...] Content analysis details: (-2.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -1.0 ALL_TRUSTED Passed through trusted hosts only via SMTP -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no From unknown Mon Aug 18 11:19:09 2025 X-Loop: help-debbugs@gnu.org Subject: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Resent-From: Eric Abrahamsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 28 Aug 2020 01:41: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 To: Lars Ingebrigtsen Cc: 29541@debbugs.gnu.org Received: via spool by 29541-submit@debbugs.gnu.org id=B29541.15985788221210 (code B ref 29541); Fri, 28 Aug 2020 01:41:01 +0000 Received: (at 29541) by debbugs.gnu.org; 28 Aug 2020 01:40:22 +0000 Received: from localhost ([127.0.0.1]:44546 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBTNN-0000JR-SO for submit@debbugs.gnu.org; Thu, 27 Aug 2020 21:40:22 -0400 Received: from ericabrahamsen.net ([52.70.2.18]:52082 helo=mail.ericabrahamsen.net) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBTNL-0000JB-D3 for 29541@debbugs.gnu.org; Thu, 27 Aug 2020 21:40:20 -0400 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 A68A4FA02E; Fri, 28 Aug 2020 01:40:12 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ericabrahamsen.net; s=mail; t=1598578812; bh=igMxgmZl4l8Zw8IqlaQ8vVIx/EBy5ine5EwLUNi2t9w=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=omZd2D3WFK1XC/NAwYw7zGAfKxMfCRv08ItLGwqHBnpJ294h8TmfMCbzWfC3r04Dg 1eRkYb4Ey+hcc3mUSfEqIFZEJpEcQKmFsVQXXqvgxR6NRk3usgHyT6JIVifJ9AL/p5 eLKzLTvYe4atQLbSjHtcuSXATo/BaS9nlucy95rM= From: Eric Abrahamsen References: <87shcsisdc.fsf@ericabrahamsen.net> <875z9q38bz.fsf@gnus.org> Date: Thu, 27 Aug 2020 18:40:11 -0700 In-Reply-To: <875z9q38bz.fsf@gnus.org> (Lars Ingebrigtsen's message of "Mon, 10 Aug 2020 16:05:04 +0200") Message-ID: <878sdzfszo.fsf@ericabrahamsen.net> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) --=-=-= 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 --=-=-=-- From unknown Mon Aug 18 11:19:09 2025 X-Loop: help-debbugs@gnu.org Subject: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation 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 To: Lars Ingebrigtsen Cc: 29541@debbugs.gnu.org Received: via spool by 29541-submit@debbugs.gnu.org id=B29541.15985788991346 (code B ref 29541); Fri, 28 Aug 2020 01:42:01 +0000 Received: (at 29541) by debbugs.gnu.org; 28 Aug 2020 01:41:39 +0000 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 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 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= From: Eric Abrahamsen In-Reply-To: <875z9q38bz.fsf@gnus.org> (Lars Ingebrigtsen's message of "Mon, 10 Aug 2020 16:05:04 +0200") References: <87shcsisdc.fsf@ericabrahamsen.net> <875z9q38bz.fsf@gnus.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Date: Thu, 27 Aug 2020 18:41:29 -0700 Message-ID: <87zh6feed2.fsf@ericabrahamsen.net> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) --=-=-= 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 --=-=-=-- From unknown Mon Aug 18 11:19:09 2025 X-Loop: help-debbugs@gnu.org Subject: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Resent-From: Lars Ingebrigtsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 28 Aug 2020 14:19:02 +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 To: Eric Abrahamsen Cc: 29541@debbugs.gnu.org Received: via spool by 29541-submit@debbugs.gnu.org id=B29541.159862429611708 (code B ref 29541); Fri, 28 Aug 2020 14:19:02 +0000 Received: (at 29541) by debbugs.gnu.org; 28 Aug 2020 14:18:16 +0000 Received: from localhost ([127.0.0.1]:47051 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBfCq-00032m-Bn for submit@debbugs.gnu.org; Fri, 28 Aug 2020 10:18:16 -0400 Received: from quimby.gnus.org ([95.216.78.240]:50052) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBfCo-00032Y-TW for 29541@debbugs.gnu.org; Fri, 28 Aug 2020 10:18:15 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org; s=20200322; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date: References:Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding: Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender: Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe: List-Subscribe:List-Post:List-Owner:List-Archive; bh=bBZ1qDULbbUnzdpxNzpQqURMjrQmDihuxl++/IxTNlo=; b=ZebcTErms+0pXZfyP8xSrspCm6 3RJur8Z8Q95m4kPxRmsScjJAPRB3GXPP8juLBK9HD5tZI+s14DFDG9Y60OIHBXitYGOSX3gw4HA/K Z5UBcsXRphyG9g8RAeMQNftaZ8TM3H1hTg3fljdLJ2FI4xbKWRBmzaf87BkoC4l+lcEs=; Received: from cm-84.212.202.86.getinternet.no ([84.212.202.86] helo=xo) by quimby with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kBfCf-00031u-JF; Fri, 28 Aug 2020 16:18:08 +0200 From: Lars Ingebrigtsen References: <87shcsisdc.fsf@ericabrahamsen.net> <875z9q38bz.fsf@gnus.org> <87zh6feed2.fsf@ericabrahamsen.net> Face: iVBORw0KGgoAAAANSUhEUgAAADAAAAAwAgMAAAAqbBEUAAAABGdBTUEAALGPC/xhBQAAACBj SFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAADFBMVEWpuctxj8g9R1r/ //8QJ8S9AAAAAWJLR0QDEQxM8gAAAAd0SU1FB+QIHA4FDBXhxbYAAAFlSURBVCjPTZIxj9swDIUf jVMGTyrQ3JCps38FPWS5yQHMAPXcpf4V7trJGW73kBxs/so+ykXuOAj6RIl8TxIgZh2ecTTkT+jT Z8rMdF8FZNj2hPYc3B/AsG3gWrVB3GfUExNVzIIXQl37HgWqMh19FuA0/Xh118Y7Aw5LSqaHzrXl 0Q0Xa5dqLc3G6Tt+ymkOMVrfRebMbkdodP0l9R2UmxR+0zxqsnBzGe5yWJGo85vZFXmcIcWNzFI5 zb4EJOTmbeqtDRjb6uGPYtfMl8b/3s49bRM+3D8WBWsT3JMvOa4s4I5mTQF6pK00uKgZdw4b+/qk YkyWGKcsccbsbHZaXpACWuKw7tqMj2LXtXk/o8hIlpyuCB21Ghvc+lKg4zj4e1cOMdde3XKBEmz9 nEd8hb2AfMko5Anxruh0h/+fQGjb/c/+C/iABLoG77DyLcBDasbrA2vjzh9w7CAt3mKf6G/WvPwD bX2cIoGJqjYAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjAtMDgtMjhUMTQ6MDU6MTIrMDA6MDBCuCXs AAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIwLTA4LTI4VDE0OjA1OjEyKzAwOjAwM+WdUAAAAABJRU5E rkJggg== X-Now-Playing: Mike Oldfield's _Tubular Bells (1)_: "Tubular Bells Part Two" Date: Fri, 28 Aug 2020 16:18:04 +0200 In-Reply-To: <87zh6feed2.fsf@ericabrahamsen.net> (Eric Abrahamsen's message of "Thu, 27 Aug 2020 18:41:29 -0700") Message-ID: <87a6yevopv.fsf@gnus.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Eric Abrahamsen 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 funct [...] Content analysis details: (-2.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -1.0 ALL_TRUSTED Passed through trusted hosts only via SMTP -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Eric Abrahamsen 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 From unknown Mon Aug 18 11:19:09 2025 X-Loop: help-debbugs@gnu.org Subject: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Resent-From: Eric Abrahamsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 28 Aug 2020 15:25:02 +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 To: Lars Ingebrigtsen Cc: 29541@debbugs.gnu.org, 29541-done@debbugs.gnu.org Received: via spool by 29541-submit@debbugs.gnu.org id=B29541.159862826126816 (code B ref 29541); Fri, 28 Aug 2020 15:25:02 +0000 Received: (at 29541) by debbugs.gnu.org; 28 Aug 2020 15:24:21 +0000 Received: from localhost ([127.0.0.1]:47184 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBgEm-0006yN-QK for submit@debbugs.gnu.org; Fri, 28 Aug 2020 11:24:21 -0400 Received: from ericabrahamsen.net ([52.70.2.18]:50808 helo=mail.ericabrahamsen.net) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBgEl-0006y2-3V; Fri, 28 Aug 2020 11:24:19 -0400 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 A905FFA07E; Fri, 28 Aug 2020 15:24:12 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ericabrahamsen.net; s=mail; t=1598628253; bh=rDE6IA4hWfFvvxyVsyPyRDhlkoJZC1jKqnCjJEX32Ok=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=Xqxr5riGHlbOhAUHP22QmRI6E//BaUYJYK9zJVUBdOBKwe4bWGWVN081ea6eh4Pz5 731f2ivCZwB5WaF78r3et1SyN6GAkPo/ranOIn3yI4IhG9QYvOrX14Rrq+jo/4Eg+1 C5GbEslKJ43ydyGvs4laxGVtEzGbasgHWtZ9i91U= From: Eric Abrahamsen References: <87shcsisdc.fsf@ericabrahamsen.net> <875z9q38bz.fsf@gnus.org> <87zh6feed2.fsf@ericabrahamsen.net> <87a6yevopv.fsf@gnus.org> Date: Fri, 28 Aug 2020 08:24:10 -0700 In-Reply-To: <87a6yevopv.fsf@gnus.org> (Lars Ingebrigtsen's message of "Fri, 28 Aug 2020 16:18:04 +0200") Message-ID: <87zh6eiyjp.fsf@ericabrahamsen.net> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) On 08/28/20 16:18 PM, Lars Ingebrigtsen wrote: > Eric Abrahamsen 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. From unknown Mon Aug 18 11:19:09 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.505 (Entity 5.505) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Eric Abrahamsen Subject: bug#29541: closed (Re: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation) Message-ID: References: <87zh6eiyjp.fsf@ericabrahamsen.net> <87shcsisdc.fsf@ericabrahamsen.net> X-Gnu-PR-Message: they-closed 29541 X-Gnu-PR-Package: emacs X-Gnu-PR-Keywords: patch Reply-To: 29541@debbugs.gnu.org Date: Fri, 28 Aug 2020 15:25:02 +0000 Content-Type: multipart/mixed; boundary="----------=_1598628302-26884-1" This is a multi-part message in MIME format... ------------=_1598628302-26884-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" Your bug report #29541: 27.0.50; Use generic function when restoring eieio-persistent, remo= ve validation which was filed against the emacs package, has been closed. The explanation is attached below, along with your original report. If you require more details, please reply to 29541@debbugs.gnu.org. --=20 29541: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D29541 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1598628302-26884-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at 29541-done) by debbugs.gnu.org; 28 Aug 2020 15:24:20 +0000 Received: from localhost ([127.0.0.1]:47182 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBgEm-0006yK-Je for submit@debbugs.gnu.org; Fri, 28 Aug 2020 11:24:20 -0400 Received: from ericabrahamsen.net ([52.70.2.18]:50808 helo=mail.ericabrahamsen.net) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kBgEl-0006y2-3V; Fri, 28 Aug 2020 11:24:19 -0400 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 A905FFA07E; Fri, 28 Aug 2020 15:24:12 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ericabrahamsen.net; s=mail; t=1598628253; bh=rDE6IA4hWfFvvxyVsyPyRDhlkoJZC1jKqnCjJEX32Ok=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=Xqxr5riGHlbOhAUHP22QmRI6E//BaUYJYK9zJVUBdOBKwe4bWGWVN081ea6eh4Pz5 731f2ivCZwB5WaF78r3et1SyN6GAkPo/ranOIn3yI4IhG9QYvOrX14Rrq+jo/4Eg+1 C5GbEslKJ43ydyGvs4laxGVtEzGbasgHWtZ9i91U= From: Eric Abrahamsen To: Lars Ingebrigtsen Subject: Re: bug#29541: 27.0.50; Use generic function when restoring eieio-persistent, remove validation References: <87shcsisdc.fsf@ericabrahamsen.net> <875z9q38bz.fsf@gnus.org> <87zh6feed2.fsf@ericabrahamsen.net> <87a6yevopv.fsf@gnus.org> Date: Fri, 28 Aug 2020 08:24:10 -0700 In-Reply-To: <87a6yevopv.fsf@gnus.org> (Lars Ingebrigtsen's message of "Fri, 28 Aug 2020 16:18:04 +0200") Message-ID: <87zh6eiyjp.fsf@ericabrahamsen.net> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 29541-done Cc: 29541@debbugs.gnu.org, 29541-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) On 08/28/20 16:18 PM, Lars Ingebrigtsen wrote: > Eric Abrahamsen 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. ------------=_1598628302-26884-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at submit) by debbugs.gnu.org; 3 Dec 2017 00:12:24 +0000 Received: from localhost ([127.0.0.1]:42283 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eLHtQ-0005xH-8n for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:12:24 -0500 Received: from eggs.gnu.org ([208.118.235.92]:46538) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eLHtN-0005x4-G0 for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:12:22 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eLHtG-0006Jl-2c for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:12:16 -0500 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50,T_DKIM_INVALID, URIBL_BLOCKED autolearn=disabled version=3.3.2 Received: from lists.gnu.org ([2001:4830:134:3::11]:40560) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1eLHtF-0006Jg-U7 for submit@debbugs.gnu.org; Sat, 02 Dec 2017 19:12:14 -0500 Received: from eggs.gnu.org ([2001:4830:134:3::10]:37500) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eLHtD-0000x6-Qm for bug-gnu-emacs@gnu.org; Sat, 02 Dec 2017 19:12:13 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eLHt8-0006BM-Pa for bug-gnu-emacs@gnu.org; Sat, 02 Dec 2017 19:12:11 -0500 Received: from mail.ericabrahamsen.net ([50.56.99.223]:37614) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1eLHt8-000666-Ft for bug-gnu-emacs@gnu.org; Sat, 02 Dec 2017 19:12:06 -0500 Received: from localhost (71-212-22-173.tukw.qwest.net [71.212.22.173]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (Client did not present a certificate) (Authenticated sender: eric@ericabrahamsen.net) by mail.ericabrahamsen.net (Postfix) with ESMTPSA id BA297C0241 for ; Sun, 3 Dec 2017 00:11:58 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=mail.ericabrahamsen.net; s=mail; t=1512259919; bh=ulZs6fy7aidvXVW7aVjitJGT0t39J7P72ekD99I2JDw=; h=From:To:Subject:Date:From; b=dS34lvZlmFigOxawThj5tPEU5kQvaom6SV83fqBRJWWrZ1O7N1bJUPNcxz2sbmxUe FiDLIAr7fFBFD8nax6CZZ+CXs6yRmz2dov8qYCfbIVIWllgHBT2uzN4cR1IdWC4Tx+ tLdH8k4CLnGimcI6EwbdFw2dHLoCTyhiIk4Qh7fc= From: Eric Abrahamsen To: bug-gnu-emacs@gnu.org Subject: 27.0.50; Use generic function when restoring eieio-persistent, remove validation Date: Sat, 02 Dec 2017 16:10:07 -0800 Message-ID: <87shcsisdc.fsf@ericabrahamsen.net> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 2001:4830:134:3::11 X-Spam-Score: -4.1 (----) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -4.1 (----) --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Replace-eieio-persistent-convert-list-to-object-with.patch >From 858b6ca64ad088362800e3ce4d5c0b34114f9b06 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen 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 --=-=-=-- ------------=_1598628302-26884-1--