From 109c27341e35fae778b95e0eb5d4d72927bf4ea8 Mon Sep 17 00:00:00 2001 From: akater Date: Mon, 12 Jul 2021 14:15:54 +0000 Subject: [PATCH] EIEIO: Prevent excessive evaluation of :initform * lisp/emacs-lisp/eieio.el (initialize-instance): Do not evaluate initform of a slot when initarg for the slot is provided, according to the following secitons of CLHS: - Object Creation and Initialization - Initialization Arguments - Defaulting of Initialization Arguments - Rules for Initialization Arguments * test/lisp/emacs-lisp/eieio-etests/eieio-tests.el: Add corresponding tests Fix a typo --- lisp/emacs-lisp/eieio.el | 35 +++++++++++-------- .../emacs-lisp/eieio-tests/eieio-tests.el | 16 ++++++++- 2 files changed, 36 insertions(+), 15 deletions(-) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1c8c372aaef..b31ea42a99b 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -53,6 +53,7 @@ (message eieio-version)) (require 'eieio-core) +(eval-when-compile (require 'subr-x)) ;;; Defining a new class @@ -740,31 +741,37 @@ Called from the constructor routine." "Construct the new object THIS based on SLOTS.") (cl-defmethod initialize-instance ((this eieio-default-superclass) - &optional slots) + &optional args) "Construct the new object THIS based on SLOTS. -SLOTS is a tagged list where odd numbered elements are tags, and +ARGS is a property list where odd numbered elements are tags, and even numbered elements are the values to store in the tagged slot. If you overload the `initialize-instance', there you will need to call `shared-initialize' yourself, or you can call `call-next-method' to have this constructor called automatically. If these steps are not taken, then new objects of your class will not have their values -dynamically set from SLOTS." - ;; First, see if any of our defaults are `lambda', and - ;; re-evaluate them and apply the value to our slots. +dynamically set from ARGS." (let* ((this-class (eieio--object-class this)) + (initargs args) (slots (eieio--class-slots this-class))) (dotimes (i (length slots)) - ;; For each slot, see if we need to evaluate it. + ;; For each slot, see if we need to evaluate its initform. (let* ((slot (aref slots i)) + (slot-name (eieio-slot-descriptor-name slot)) (initform (cl--slot-descriptor-initform slot))) - ;; Those slots whose initform is constant already have the right - ;; value set in the default-object. - (unless (macroexp-const-p initform) - ;; FIXME: We should be able to just do (aset this (+ i ) dflt)! - (eieio-oset this (cl--slot-descriptor-name slot) - (eval initform t)))))) - ;; Shared initialize will parse our slots for us. - (shared-initialize this slots)) + (unless (or (when-let ((initarg + (car (rassq slot-name + (eieio--class-initarg-tuples + this-class))))) + (plist-get initargs initarg)) + ;; Those slots whose initform is constant already have + ;; the right value set in the default-object. + (macroexp-const-p initform)) + ;; FIXME: Use `aset' instead of `eieio-oset', relying on that + ;; vector returned by `eieio--class-slots' + ;; should be congruent with the object itself. + (eieio-oset this slot-name (eval initform t)))))) + ;; Shared initialize will parse our args for us. + (shared-initialize this args)) (cl-defgeneric slot-missing (object slot-name _operation &optional _new-value) "Method invoked when an attempt to access a slot in OBJECT fails. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 11ffc115f7e..3ec42343443 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -574,7 +574,21 @@ METHOD is the method that was attempting to be called." (setf (get-slot-3 eitest-t1) 'setf-emu) (should (eq (get-slot-3 eitest-t1) 'setf-emu)) ;; Roll back - (setf (get-slot-3 eitest-t1) 'emu)) + (setf (get-slot-3 eitest-t1) 'emu) + (defvar eieio-tests-initform-was-evaluated) + (defclass eieio-tests-initform-not-evaluated-when-initarg-is-present () + ((slot-with-initarg-and-initform + :initarg :slot-with-initarg-and-initform + :initform (setf eieio-tests-initform-was-evaluated t)))) + (setq eieio-tests-initform-was-evaluated nil) + (make-instance + 'eieio-tests-initform-not-evaluated-when-initarg-is-present) + (should eieio-tests-initform-was-evaluated) + (setq eieio-tests-initform-was-evaluated nil) + (make-instance + 'eieio-tests-initform-not-evaluated-when-initarg-is-present + :slot-with-initarg-and-initform t) + (should-not eieio-tests-initform-was-evaluated)) (defvar eitest-t2 nil) (ert-deftest eieio-test-26-default-inheritance () -- 2.39.2