>From 75990f852a03436f84bd42f9ce22975a6b0c166a Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Mon, 12 Jul 2021 14:15:54 +0000
Subject: [PATCH] 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                      | 28 ++++++++++++-------
 .../emacs-lisp/eieio-tests/eieio-tests.el     | 16 ++++++++++-
 2 files changed, 33 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1c8c372aae..76b2eab494 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -53,6 +53,7 @@ defun eieio-version ()
   (message eieio-version))
 
 (require 'eieio-core)
+(eval-when-compile (require 'subr-x))
 
 
 ;;; Defining a new class
@@ -740,7 +741,7 @@ defclass eieio-default-superclass nil
   "Construct the new object THIS based on SLOTS.")
 
 (cl-defmethod initialize-instance ((this eieio-default-superclass)
-				&optional slots)
+				   &optional slots)
   "Construct the new object THIS based on SLOTS.
 SLOTS is a tagged list where odd numbered elements are tags, and
 even numbered elements are the values to store in the tagged slot.
@@ -749,20 +750,27 @@ defclass eieio-default-superclass nil
 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.
   (let* ((this-class (eieio--object-class this))
+         (initargs slots)
          (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 <cst>) dflt)!
-          (eieio-oset this (cl--slot-descriptor-name slot)
-                      (eval initform t))))))
+        (unless (or (eq eieio--unbound initform)
+                    (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 slots for us.
   (shared-initialize this slots))
 
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 11ffc115f7..3ec4234344 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 @@ defvar eitest-t1 nil)
   (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.31.1