bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 80 bytes --]

Better make it an actual bug report, so we have a bug-number.


        Stefan


[-- Attachment #2: Type: message/rfc822, Size: 9625 bytes --]

[-- Attachment #2.1.1.1: Type: text/plain, Size: 0 bytes --]



[-- Attachment #2.1.1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2.1.2: Fix eval initform --]
[-- Type: text/x-diff, Size: 2137 bytes --]

From 595083dac6dd0fe3446e182c710fbb2a5a648994 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Wed, 30 Jun 2021 11:43:23 +0000
Subject: [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform:

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
---
 lisp/emacs-lisp/eieio.el | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1c8c372aae..758bddd592 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -740,7 +740,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.
@@ -756,13 +756,15 @@ defclass eieio-default-superclass nil
     (dotimes (i (length slots))
       ;; For each slot, see if we need to evaluate it.
       (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)
+        (unless (or (rassq slot-name
+                           (eieio--class-initarg-tuples this-class))
+                    (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))))))
+          (eieio-oset this slot-name (eval initform t))))))
   ;; Shared initialize will parse our slots for us.
   (shared-initialize this slots))
 
-- 
2.31.1


[-- Attachment #2.1.3: Type: text/plain, Size: 5995 bytes --]


* Summary
According to CLHS,
#+begin_quote
A default initial value form for a slot is defined by using the
:initform slot option to defclass. If no initialization argument
associated with that slot is given as an argument to make-instance or is
defaulted by :default-initargs, this default initial value form is
evaluated in the lexical environment of the defclass form that defined
it, and the resulting value is stored in the slot.
#+end_quote
--- [[clhs::07_a.htm][Object Creation and Initialization]]

This is not what happens in eieio.  Rather, initform is evaluated even
when initarg is present.

* Emacs Lisp examples
Define a class with a slot that has an initarg and an initform involving
undefined function:
#+begin_src emacs-lisp
(defclass test-initform ()
  ((test-slot :initarg :test-slot :initform (identity (non-existent)))))
#+end_src

Now,
#+begin_src emacs-lisp :results code :wrap example emacs-lisp
(condition-case err (make-instance 'test-initform :test-slot 0)
  (t err))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(void-function non-existent)
#+end_example

Even though initform should not be evaluated since initarg is provided.

* Other references from CLHS
#+begin_quote
If the initialization argument has a value in the initialization
argument list, the value is stored into the slot of the newly created
object, overriding any :initform form associated with the slot.
#+end_quote
--- [[clhs::07_aa.htm][Initialization Arguments]]

#+begin_quote
An :initform form is used to initialize a slot only if no initialization
argument associated with that slot is given as an argument to
make-instance or is defaulted by :default-initargs.
#+end_quote
--- [[clhs::07_ac.htm][Defaulting of Initialization Arguments]]

#+begin_quote
If a slot has both an :initform form and an :initarg slot option, and
the initialization argument is defaulted using :default-initargs or is
supplied to make-instance, the captured :initform form is neither used
nor evaluated.
#+end_quote
--- [[clhs::07_ad.htm][Rules for Initialization Arguments]]

* Common Lisp examples
Define a class in exactly the same way as in Emacs Lisp:
#+begin_src lisp :results errors :wrap example lisp
(defclass test-initform ()
  ((test-slot :initarg :test-slot :initform (identity (non-existent)))))
#+end_src

#+RESULTS:
#+begin_example lisp
; in: DEFCLASS TEST-INITFORM
;     (NON-EXISTENT)
; 
; caught STYLE-WARNING:
;   undefined function: COMMON-LISP-USER::NON-EXISTENT
; 
; compilation unit finished
;   Undefined function:
;     NON-EXISTENT
;   caught 1 STYLE-WARNING condition
#+end_example

Appropriately,
#+begin_src lisp :results value verbatim :wrap example lisp
(ignore-errors (make-instance 'test-initform))
#+end_src

#+RESULTS:
#+begin_example lisp
NIL
#<UNDEFINED-FUNCTION NON-EXISTENT {10052CF123}>
#+end_example

But with initarg, there is no need to evaluate initform, and it is not
evaluated:
#+begin_src lisp :results value verbatim :wrap example lisp
(make-instance 'test-initform :test-slot 0)
#+end_src

#+RESULTS:
#+begin_example lisp
#<TEST-INITFORM {1005224E13}>
#+end_example

* Notes
** Initializing to quoted initform
Emacs 27 source claims:
#+begin_quote
Paul Landes said in an email:
> CL evaluates it if it can, and otherwise, leaves it as
> the quoted thing as you already have.  This is by the
> Sonya E. Keene book and other things I've look at on the
> web.
#+end_quote
--- [[file:/usr/share/emacs/27.2/lisp/emacs-lisp/eieio.el::;; Paul Landes said in an email:][EIEIO on initform quoting]]

And eieio does quote initform forms with cars being symbols that are not fbound:
#+begin_src lisp :results none
(defclass test-initform-quote ()
  ((test-slot :initform (non-existent))))
#+end_src

#+begin_src emacs-lisp :results code :wrap example emacs-lisp
(slot-value (make-instance 'test-initform-quote) 'test-slot)
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(non-existent)
#+end_example

There is however no reference to Sonya E. Keene or anything else.  Meanwhile,
#+begin_src lisp :results errors :wrap example lisp
(defclass test-initform-quote ()
  ((test-slot :initform (non-existent))))
#+end_src

#+RESULTS:
#+begin_example lisp
; in: DEFCLASS TEST-INITFORM-QUOTE
;     (NON-EXISTENT)
; 
; caught STYLE-WARNING:
;   undefined function: COMMON-LISP-USER::NON-EXISTENT
; 
; compilation unit finished
;   Undefined function:
;     NON-EXISTENT
;   caught 1 STYLE-WARNING condition
#+end_example

#+begin_src lisp :results value verbatim :wrap example emacs-lisp
(ignore-errors (make-instance 'test-initform-quote))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
NIL
#<UNDEFINED-FUNCTION NON-EXISTENT {1003251A33}>
#+end_example

Also, when discussing interplay between initform and default-initargs, Sonya E. Keene mentions:
#+begin_quote
The value of an :initform is evaluated each time it is used to initialize a slot.
#+end_quote
--- Sonya E. Keene, Object Oriented Programming in Common Lisp:
    A Programmer's Guide.  9.3. Controlling Initialization
    With ~defclass~ Options

similarly stated in CLHS, in “Macro DEFCLASS”.

Emacs 28 source removes the claim but adds
#+begin_quote
FIXME: Historically, EIEIO used a heuristic to try and guess
whether the initform is a form to be evaluated or just
a constant.  We use `eieio--eval-default-p' to see what the
heuristic says and if it disagrees with normal evaluation
then tweak the initform to make it fit and emit
a warning accordingly.
#+end_quote
--- [[file:~/src/emacs/lisp/emacs-lisp/eieio.el::;; FIXME: Historically, EIEIO used a heuristic to try and guess][eieio in git]]

which arguably makes matters even more confusing.  There should be no
such heuristic.

* Patch
We offer a patch for Emacs 28 (master) but we can't build Emacs 28 (the
bug had been filed) so it's untested and “works for me”.

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Stefan Monnier [2021-06-30 09:32:32] wrote:

> This is not what happens in eieio.  Rather, initform is evaluated even
> when initarg is present.

Good catch, thanks.

> @@ -756,13 +756,15 @@ defclass eieio-default-superclass nil
>      (dotimes (i (length slots))
>        ;; For each slot, see if we need to evaluate it.
>        (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)
> +        (unless (or (rassq slot-name
> +                           (eieio--class-initarg-tuples this-class))
> +                    (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))))))
> +          (eieio-oset this slot-name (eval initform t))))))
>    ;; Shared initialize will parse our slots for us.
>    (shared-initialize this slots))

Hmm... if I read this correctly, you prevents the (eval initform t) for
all slots that were declared with `:initarg <KEYWORD>`, whereas AFAIK the
right semantic is to prevent the (eval initform t) in the case where the
corresponding <KEYWORD> was passed to `make-instance`.

So we should pay attention to `slots` (the arg, not the local var) to
decide whether to skip (eval initform t).


        Stefan

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

akater [2021-06-30 14:02:01] wrote:
> You're right, I'll check for `slots`.  Got confused as to where initargs
> were stored, and lost the check.

Sorry, I mistyped the address in my reply, it should be

    49291 <AT> debbugs.gnu.org

instead of

    49291 <AT> gnu.org

bug#49291: [akater] Re: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[akater]

[-- Attachment #1: Type: text/plain, Size: 300 bytes --]


-------------------- Start of forwarded message --------------------
From: akater <nuclearspace@gmail.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>, 49291@gnu.org
Subject: Re: [akater] [PATCH] lisp/emacs-lisp/eieio.el
 (initialize-instance): Fix initform
Date: Wed, 30 Jun 2021 16:44:12 +0000


[-- Attachment #2.1.1: Type: text/plain, Size: 1600 bytes --]

There are iusses, some stylistic, some related to comments in the code.

- There is a comment here:

> First, see if any of our defaults are `lambda', and
> re-evaluate them and apply the value to our slots.             

I don't observe anything like this happening.  Looks like it refers to
eieio-default-eval-maybe (likely referring to any compound form with
fbound car as to `lambda') which used to be in eieio-core in 27 but now
is gone.  Maybe we should drop this comment?

- There is a comment:

> For each slot, see if we need to evaluate it

Slots are self-evaluating objects; I think it was meant to be “to
evaluate its initform”.

- There is FIXME

> FIXME: We should be able to just do (aset this (+ i <cst>) dflt)!                                                          

Local variable dflt had been removed after Emacs 27 release.  The
comment should likely have been gone too, or at least updated.  It
suggests to assign the value of initform with a low-level `aset' applied
to eieio--class struct but (1) I don't understand the + i shift (2)
eieio--class is not declared to be of :type vector, neither does it
inherit from a struct declared to be of :type vector.  I suggest to
replace the comment with
“TODO: maybe specify eieio--class as vector and use aset here”

- I employ when-let which requires subr-x at compile time.  I can't
check the build cleanly right now, only with some dirty reverts related
to libseccomp issues but aside from that, this subr-x dependency doesn't
break byte-compilation of eieio.el.  I hope it's fine?


[-- Attachment #2.1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2.2: Fix eval initform --]
[-- Type: text/x-diff, Size: 3253 bytes --]

From 588e7ff1b34ccfbc9e3cb97d06ae3315487d42c9 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Wed, 30 Jun 2021 11:43:23 +0000
Subject: [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix eval
 initform:

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
---
 lisp/emacs-lisp/eieio.el | 26 ++++++++++++++++----------
 1 file changed, 16 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1c8c372aae..ec05a07307 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))
 
 \f
 ;;; 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,25 @@ 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))
+          ;; TODO: Maybe specify eieio--class as vector explicitly and use aset
+          (eieio-oset this slot-name (eval initform t))))))
   ;; Shared initialize will parse our slots for us.
   (shared-initialize this slots))
 
-- 
2.31.1


[-- Attachment #3: Type: text/plain, Size: 67 bytes --]

-------------------- End of forwarded message --------------------

[-- Attachment #4.1: Type: text/plain, Size: 0 bytes --]



[-- Attachment #4.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

bug#49291: [akater] Re: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 38 bytes --]

[ Why, oh why, did I mistype this? ]


[-- Attachment #2: Type: message/rfc822, Size: 6651 bytes --]

[-- Attachment #2.1.1.1: Type: text/plain, Size: 1600 bytes --]

There are iusses, some stylistic, some related to comments in the code.

- There is a comment here:

> First, see if any of our defaults are `lambda', and
> re-evaluate them and apply the value to our slots.             

I don't observe anything like this happening.  Looks like it refers to
eieio-default-eval-maybe (likely referring to any compound form with
fbound car as to `lambda') which used to be in eieio-core in 27 but now
is gone.  Maybe we should drop this comment?

- There is a comment:

> For each slot, see if we need to evaluate it

Slots are self-evaluating objects; I think it was meant to be “to
evaluate its initform”.

- There is FIXME

> FIXME: We should be able to just do (aset this (+ i <cst>) dflt)!                                                          

Local variable dflt had been removed after Emacs 27 release.  The
comment should likely have been gone too, or at least updated.  It
suggests to assign the value of initform with a low-level `aset' applied
to eieio--class struct but (1) I don't understand the + i shift (2)
eieio--class is not declared to be of :type vector, neither does it
inherit from a struct declared to be of :type vector.  I suggest to
replace the comment with
“TODO: maybe specify eieio--class as vector and use aset here”

- I employ when-let which requires subr-x at compile time.  I can't
check the build cleanly right now, only with some dirty reverts related
to libseccomp issues but aside from that, this subr-x dependency doesn't
break byte-compilation of eieio.el.  I hope it's fine?


[-- Attachment #2.1.1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2.1.2: Fix eval initform --]
[-- Type: text/x-diff, Size: 3253 bytes --]

From 588e7ff1b34ccfbc9e3cb97d06ae3315487d42c9 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Wed, 30 Jun 2021 11:43:23 +0000
Subject: [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix eval
 initform:

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
---
 lisp/emacs-lisp/eieio.el | 26 ++++++++++++++++----------
 1 file changed, 16 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1c8c372aae..ec05a07307 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))
 
 \f
 ;;; 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,25 @@ 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))
+          ;; TODO: Maybe specify eieio--class as vector explicitly and use aset
+          (eieio-oset this slot-name (eval initform t))))))
   ;; Shared initialize will parse our slots for us.
   (shared-initialize this slots))
 
-- 
2.31.1

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> There are iusses, some stylistic, some related to comments in the code.
> - There is a comment here:
>> First, see if any of our defaults are `lambda', and
>> re-evaluate them and apply the value to our slots.
> I don't observe anything like this happening.  Looks like it refers to
> eieio-default-eval-maybe (likely referring to any compound form with
> fbound car as to `lambda') which used to be in eieio-core in 27 but now
> is gone.

I think it's called `eieio--eval-default-p` nowadays.

> Maybe we should drop this comment?

Indeed, thanks.  `eieio--eval-default-p` is not used here any more
(it's only used in `defclass` (and its corresponding function) nowadays).

> - There is a comment:
>> For each slot, see if we need to evaluate it
> Slots are self-evaluating objects; I think it was meant to be “to
> evaluate its initform”.

LGTM, thanks.

> - There is FIXME
>> FIXME: We should be able to just do (aset this (+ i <cst>) dflt)!
> Local variable dflt had been removed after Emacs 27 release.  The
> comment should likely have been gone too, or at least updated.  It
> suggests to assign the value of initform with a low-level `aset' applied
> to eieio--class struct

No, not to the eieio--class but to the new object.
Basically replacing the `eieio-oset` with `aset`.  This is because the
vector returned by `eieio--class-slots` should contain the slots info in
the same order as the slots themselves are found in the actual object so
we don't need to ask `eieio-set` to find the slots's position in
the object.

> - I employ when-let which requires subr-x at compile time.  I can't
> check the build cleanly right now, only with some dirty reverts related
> to libseccomp issues but aside from that, this subr-x dependency doesn't
> break byte-compilation of eieio.el.  I hope it's fine?

That Looks fine, thanks.
But could you add a test or two to
test/lisp/emacs-lisp/eieio-tests/eieio-tests.el ?


        Stefan

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[akater]

[-- Attachment #1: Type: text/plain, Size: 1241 bytes --]


> No, not to the eieio--class but to the new object.

Right, I was confused.  I left the word FIXME but rephrased the comment
so that we don't mention the non-existent dflt.  At the moment, I'm not
ready to reimplement this with aset and to ensure it would not break by
accident in an obscure manner.

> But could you add a test or two to
> test/lisp/emacs-lisp/eieio-tests/eieio-tests.el ?

I added sort of exhaustive tests for initialization.  A complete
exhaustive test would also take :default-initargs and inheritance into
account but I'd rather do this gradually.  I did not run tests in Emacs
28 but they pass as is in Emacs 27.

Some :initform's needed a fix (quote), some could be improved (search
for “symbol-value” in the patch).

The necessity to quote should be expected to break some packages, maybe
a lot.  E.g. helm contained one unquoted such instance.  I already fixed
it; nothing else broke for me so far but it was easy to omit this quote.

If authors get confused about initform workings, it may help to note
that :initform actually expects a *form*, i.e. expression to be
evaluated.  The attempt to guess what to evaluate and what not was based
on the wrong premise that CL does that.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix eval initform --]
[-- Type: text/x-diff, Size: 16163 bytes --]

From b581745bc80d5b9c0b83446e42f50103fccded4e Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Wed, 30 Jun 2021 11:43:23 +0000
Subject: [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix eval
 initform:

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

Add corresponding tests.

Replace :initform (symbol-value 'x) to :initform x everywhere.

Quote all initforms explicitly where necessary.
---
 lisp/emacs-lisp/eieio.el                      | 28 ++++--
 lisp/gnus/gnus-search.el                      | 52 +++++-----
 lisp/registry.el                              |  2 +-
 .../emacs-lisp/eieio-tests/eieio-tests.el     | 97 ++++++++++++++++---
 4 files changed, 128 insertions(+), 51 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))
 
 \f
 ;;; 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/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 70bde264c1..202d93e053 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -787,7 +787,7 @@ defclass gnus-search-imap (gnus-search-engine)
     This slot is set automatically by the imap server, and cannot
     be set manually.  Currently only partially implemented.")
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-imap-raw-queries-p)))
+    :initform gnus-search-imap-raw-queries-p))
     :documentation
   "The base IMAP search engine, using an IMAP server's search capabilities.
 This backend may be subclassed to handle particular IMAP servers'
@@ -841,67 +841,67 @@ defclass gnus-search-indexed (gnus-search-engine
 (defclass gnus-search-swish-e (gnus-search-indexed)
   ((index-files
     :init-arg :index-files
-    :initform (symbol-value 'gnus-search-swish-e-index-files)
+    :initform gnus-search-swish-e-index-files
     :type list)
    (program
-    :initform (symbol-value 'gnus-search-swish-e-program))
+    :initform gnus-search-swish-e-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-swish-e-remove-prefix))
+    :initform gnus-search-swish-e-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-swish-e-switches))
+    :initform gnus-search-swish-e-switches)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-swish-e-raw-queries-p))))
+    :initform gnus-search-swish-e-raw-queries-p)))
 
 (defclass gnus-search-swish++ (gnus-search-indexed)
   ((program
-    :initform (symbol-value 'gnus-search-swish++-program))
+    :initform gnus-search-swish++-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-swish++-remove-prefix))
+    :initform gnus-search-swish++-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-swish++-switches))
+    :initform gnus-search-swish++-switches)
    (config-file
-    :initform (symbol-value 'gnus-search-swish++-config-file))
+    :initform gnus-search-swish++-config-file)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-swish++-raw-queries-p))))
+    :initform gnus-search-swish++-raw-queries-p)))
 
 (defclass gnus-search-mairix (gnus-search-indexed)
   ((program
-    :initform (symbol-value 'gnus-search-mairix-program))
+    :initform gnus-search-mairix-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-mairix-remove-prefix))
+    :initform gnus-search-mairix-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-mairix-switches))
+    :initform gnus-search-mairix-switches)
    (config-file
-    :initform (symbol-value 'gnus-search-mairix-config-file))
+    :initform gnus-search-mairix-config-file)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-mairix-raw-queries-p))))
+    :initform gnus-search-mairix-raw-queries-p)))
 
 (defclass gnus-search-namazu (gnus-search-indexed)
   ((index-directory
     :initarg :index-directory
-    :initform (symbol-value 'gnus-search-namazu-index-directory)
+    :initform gnus-search-namazu-index-directory
     :type string
     :custom directory)
    (program
-    :initform (symbol-value 'gnus-search-namazu-program))
+    :initform gnus-search-namazu-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-namazu-remove-prefix))
+    :initform gnus-search-namazu-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-namazu-switches))
+    :initform gnus-search-namazu-switches)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-namazu-raw-queries-p))))
+    :initform gnus-search-namazu-raw-queries-p)))
 
 (defclass gnus-search-notmuch (gnus-search-indexed)
   ((program
-    :initform (symbol-value 'gnus-search-notmuch-program))
+    :initform gnus-search-notmuch-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-notmuch-remove-prefix))
+    :initform gnus-search-notmuch-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-notmuch-switches))
+    :initform gnus-search-notmuch-switches)
    (config-file
-    :initform (symbol-value 'gnus-search-notmuch-config-file))
+    :initform gnus-search-notmuch-config-file)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-notmuch-raw-queries-p))))
+    :initform gnus-search-notmuch-raw-queries-p)))
 
 (define-obsolete-variable-alias 'nnir-method-default-engines
   'gnus-search-default-engines "28.1")
diff --git a/lisp/registry.el b/lisp/registry.el
index 258f7fc904..e0aa9d1728 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -102,7 +102,7 @@ defclass registry-db (eieio-persistent)
 	     ;; value rather than an expression, so in order to get the value
 	     ;; of `most-positive-fixnum', we need to use an
 	     ;; expression that's not just a symbol.
-             :initform (symbol-value 'most-positive-fixnum)
+             :initform most-positive-fixnum
              :type integer
              :custom integer
              :documentation "The maximum number of registry entries.")
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 11ffc115f7..e6df66a723 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -30,15 +30,16 @@
 (require 'eieio-opt)
 
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-macs))
 
 ;;; Code:
 ;; Set up some test classes
 (defclass class-a ()
   ((water :initarg :water
-	  :initform h20
+	  :initform 'h20
 	  :type symbol
 	  :documentation "Detail about water.")
-   (classslot :initform penguin
+   (classslot :initform 'penguin
 	      :type symbol
 	      :documentation "A class allocated slot."
 	      :allocation :class)
@@ -63,7 +64,7 @@ defclass class-ab (class-a class-b)
 
 (defclass class-c ()
   ((slot-1 :initarg :moose
-	   :initform moose
+	   :initform 'moose
 	   :type symbol
 	   :allocation :instance
 	   :documentation "First slot testing slot arguments."
@@ -82,7 +83,7 @@ defclass class-c ()
 	   :accessor get-slot-2
 	   :protection :private)
    (slot-3 :initarg :emu
-	   :initform emu
+	   :initform 'emu
 	   :type symbol
 	   :allocation :class
 	   :documentation "Third slot test class allocated accessor"
@@ -489,9 +490,9 @@ defvar eitest-pvinit nil)
 
 (defclass inittest nil
   ((staticval :initform 1)
-   (symval :initform eieio-test-permuting-value)
-   (evalval :initform (symbol-value 'eieio-test-permuting-value))
-   (evalnow :initform (symbol-value 'eieio-test-permuting-value)
+   (symval :initform 'eieio-test-permuting-value)
+   (evalval :initform eieio-test-permuting-value)
+   (evalnow :initform eieio-test-permuting-value
 	    :allocation :class)
    )
   "Test initforms that eval.")
@@ -555,6 +556,15 @@ defclass eitest-superior nil
     (should-not (cl-typep listooa '(list-of class-b)))
     (should-not (cl-typep listoob '(list-of class-a)))))
 
+(defclass eieio-tests-initargs-initform-interplay ()
+  ((slot-with-initarg-and-initform
+    :initarg :slot-with-initarg-and-initform
+    :initform 'value-specified-in-defclass-form)
+   (slot-with-initarg-only
+    :initarg :slot-with-initarg-only)
+   (slot-with-initform-only
+    :initform 'value-specified-in-defclass-form)))
+
 (defvar eitest-t1 nil)
 (ert-deftest eieio-test-25-slot-tests ()
   (setq eitest-t1 (class-c))
@@ -574,7 +584,66 @@ 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)
+  ;; Slot initialization according to initargs and initforms
+  (cl-macrolet
+      ((when-initargs (slots &rest noerrorp
+                             &key
+                             slot-with-initarg-and-initform
+                             slot-with-initarg-only
+                             slot-with-initform-only)
+         (cl-macrolet ((code-for
+                        (arg)
+                        `(let ((slot ,arg))
+                           (cl-case slot
+                             (unbound `(not (slot-boundp eitest-t1 ',',arg)))
+                             (nil)
+                             (t `(eq ,slot (oref eitest-t1 ,',arg)))))))
+           (let ((make-instance
+                  `(setq eitest-t1
+                         (make-instance
+                          'eieio-tests-initargs-initform-interplay
+                          ,@(cl-loop
+                             for initarg in slots
+                             collect initarg
+                             collect
+                             ''value-specified-in-make-instance-form)))))
+             (if noerrorp
+                 `(progn
+                    ,make-instance
+                    (should `(and ,',(code-for slot-with-initarg-and-initform)
+                                  ,',(code-for slot-with-initarg-only)
+                                  ,',(code-for slot-with-initform-only))))
+               `(should-error ,make-instance))))))
+    ;; Whenever slot without initarg is initialized, it's an error;
+    ;; see CLHS, 7.1.2 Declaring the Validity of Initialization Arguments.
+    ;; So, the following four should just error:
+    (when-initargs (:slot-with-initform-only))
+    (when-initargs (:slot-with-initform-only :slot-with-initarg-and-initform))
+    (when-initargs (:slot-with-initform-only :slot-with-initarg-only))
+    (when-initargs (:slot-with-initform-only :slot-with-initarg-and-initform
+                                             :slot-with-initarg-only))
+    ;; The rest should not.
+
+    (when-initargs (:slot-with-initarg-and-initform :slot-with-initarg-only)
+      :slot-with-initarg-and-initform 'value-specified-in-make-instance-form
+      :slot-with-initarg-only 'value-specified-in-make-instance-form
+      :slot-with-initform-only 'value-specified-in-defclass-form)
+
+    (when-initargs (:slot-with-initarg-and-initform)
+      :slot-with-initarg-and-initform 'value-specified-in-make-instance-form
+      :slot-with-initarg-only unbound
+      :slot-with-initform-only 'value-specified-in-defclass-form)
+
+    (when-initargs (:slot-with-initarg-only)
+      :slot-with-initarg-and-initform 'value-specified-in-defclass-form
+      :slot-with-initarg-only 'value-specified-in-make-instance-form
+      :slot-with-initform-only 'value-specified-in-defclass-form)
+
+    (when-initargs ()
+      :slot-with-initarg-and-initform 'value-specified-in-defclass-form
+      :slot-with-initarg-only unbound
+      :slot-with-initform-only 'value-specified-in-defclass-form)))
 
 (defvar eitest-t2 nil)
 (ert-deftest eieio-test-26-default-inheritance ()
@@ -696,7 +765,7 @@ defvar eitest-II3 nil)
   (setq eitest-II3 (clone eitest-II2 "eitest-II3 Test."))
   (oset eitest-II3 slot3 'penguin)
 
-  ;; Test that slots are non-initialized slots are unbounded
+  ;; Test that non-initialized slots are unbounded
   (oref eitest-II2 slot1)
   (should (slot-boundp eitest-II2 'slot1))
   (should-not (slot-boundp eitest-II2 'slot2))
@@ -715,7 +784,7 @@ defvar eitest-II3 nil)
   (should (eq (oref eitest-II3 slot3) 'penguin)))
 
 (defclass slotattr-base ()
-  ((initform :initform init)
+  ((initform :initform 'init)
    (type :type list)
    (initarg :initarg :initarg)
    (protection :protection :private)
@@ -730,7 +799,7 @@ defclass slotattr-base ()
 Subclasses to override slot attributes.")
 
 (defclass slotattr-ok (slotattr-base)
-  ((initform :initform no-init)
+  ((initform :initform 'no-init)
    (initarg :initarg :initblarg)
    (custom :custom string
 	   :label "One String"
@@ -766,7 +835,7 @@ defclass slotattr-ok (slotattr-base)
 
 (defclass slotattr-class-base ()
   ((initform :allocation :class
-	     :initform init)
+	     :initform 'init)
    (type :allocation :class
 	 :type list)
    (initarg :allocation :class
@@ -785,7 +854,7 @@ defclass slotattr-class-base ()
 Subclasses to override slot attributes.")
 
 (defclass slotattr-class-ok (slotattr-class-base)
-  ((initform :initform no-init)
+  ((initform :initform 'no-init)
    (initarg :initarg :initblarg)
    (custom :custom string
 	   :label "One String"
@@ -847,7 +916,7 @@ defvar eitest-CLONETEST2 nil)
   (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1))))
 
 (defclass IT (eieio-instance-tracker)
-  ((tracking-symbol :initform IT-list)
+  ((tracking-symbol :initform 'IT-list)
    (slot1 :initform 'die))
   "Instance Tracker test object.")
 
-- 
2.31.1

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[akater]

Note: I better improve code generation in eieio-tests to cover
(hypothetical) cases where some but not all expected values are
specified, or such (hypothetical) tests will always fail.  I will
back to this, in 10 hours or so, but for existing cases, it does not
matter.

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[akater]

[-- Attachment #1: Type: text/plain, Size: 287 bytes --]


A version with correct code generation.  Tests pass on 27.

“when-initargs” is not a perfect name but it's not a global macro, and
the name is short enough to allow two descriptive initargs to fit into
80 chars width so I decided not to spend time seeking for alternatives.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix eval initform --]
[-- Type: text/x-diff, Size: 16407 bytes --]

From 43288c414f00018b9f79c43e9e1232af41d4e1f5 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Wed, 30 Jun 2021 11:43:23 +0000
Subject: [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix eval
 initform:

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

Add corresponding tests.

Replace :initform (symbol-value 'x) to :initform x everywhere.

Quote all initforms explicitly where necessary.
---
 lisp/emacs-lisp/eieio.el                      |  28 +++--
 lisp/gnus/gnus-search.el                      |  52 ++++-----
 lisp/registry.el                              |   2 +-
 .../emacs-lisp/eieio-tests/eieio-tests.el     | 101 +++++++++++++++---
 4 files changed, 132 insertions(+), 51 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))
 
 \f
 ;;; 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/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 70bde264c1..202d93e053 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -787,7 +787,7 @@ defclass gnus-search-imap (gnus-search-engine)
     This slot is set automatically by the imap server, and cannot
     be set manually.  Currently only partially implemented.")
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-imap-raw-queries-p)))
+    :initform gnus-search-imap-raw-queries-p))
     :documentation
   "The base IMAP search engine, using an IMAP server's search capabilities.
 This backend may be subclassed to handle particular IMAP servers'
@@ -841,67 +841,67 @@ defclass gnus-search-indexed (gnus-search-engine
 (defclass gnus-search-swish-e (gnus-search-indexed)
   ((index-files
     :init-arg :index-files
-    :initform (symbol-value 'gnus-search-swish-e-index-files)
+    :initform gnus-search-swish-e-index-files
     :type list)
    (program
-    :initform (symbol-value 'gnus-search-swish-e-program))
+    :initform gnus-search-swish-e-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-swish-e-remove-prefix))
+    :initform gnus-search-swish-e-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-swish-e-switches))
+    :initform gnus-search-swish-e-switches)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-swish-e-raw-queries-p))))
+    :initform gnus-search-swish-e-raw-queries-p)))
 
 (defclass gnus-search-swish++ (gnus-search-indexed)
   ((program
-    :initform (symbol-value 'gnus-search-swish++-program))
+    :initform gnus-search-swish++-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-swish++-remove-prefix))
+    :initform gnus-search-swish++-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-swish++-switches))
+    :initform gnus-search-swish++-switches)
    (config-file
-    :initform (symbol-value 'gnus-search-swish++-config-file))
+    :initform gnus-search-swish++-config-file)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-swish++-raw-queries-p))))
+    :initform gnus-search-swish++-raw-queries-p)))
 
 (defclass gnus-search-mairix (gnus-search-indexed)
   ((program
-    :initform (symbol-value 'gnus-search-mairix-program))
+    :initform gnus-search-mairix-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-mairix-remove-prefix))
+    :initform gnus-search-mairix-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-mairix-switches))
+    :initform gnus-search-mairix-switches)
    (config-file
-    :initform (symbol-value 'gnus-search-mairix-config-file))
+    :initform gnus-search-mairix-config-file)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-mairix-raw-queries-p))))
+    :initform gnus-search-mairix-raw-queries-p)))
 
 (defclass gnus-search-namazu (gnus-search-indexed)
   ((index-directory
     :initarg :index-directory
-    :initform (symbol-value 'gnus-search-namazu-index-directory)
+    :initform gnus-search-namazu-index-directory
     :type string
     :custom directory)
    (program
-    :initform (symbol-value 'gnus-search-namazu-program))
+    :initform gnus-search-namazu-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-namazu-remove-prefix))
+    :initform gnus-search-namazu-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-namazu-switches))
+    :initform gnus-search-namazu-switches)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-namazu-raw-queries-p))))
+    :initform gnus-search-namazu-raw-queries-p)))
 
 (defclass gnus-search-notmuch (gnus-search-indexed)
   ((program
-    :initform (symbol-value 'gnus-search-notmuch-program))
+    :initform gnus-search-notmuch-program)
    (remove-prefix
-    :initform (symbol-value 'gnus-search-notmuch-remove-prefix))
+    :initform gnus-search-notmuch-remove-prefix)
    (switches
-    :initform (symbol-value 'gnus-search-notmuch-switches))
+    :initform gnus-search-notmuch-switches)
    (config-file
-    :initform (symbol-value 'gnus-search-notmuch-config-file))
+    :initform gnus-search-notmuch-config-file)
    (raw-queries-p
-    :initform (symbol-value 'gnus-search-notmuch-raw-queries-p))))
+    :initform gnus-search-notmuch-raw-queries-p)))
 
 (define-obsolete-variable-alias 'nnir-method-default-engines
   'gnus-search-default-engines "28.1")
diff --git a/lisp/registry.el b/lisp/registry.el
index 258f7fc904..e0aa9d1728 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -102,7 +102,7 @@ defclass registry-db (eieio-persistent)
 	     ;; value rather than an expression, so in order to get the value
 	     ;; of `most-positive-fixnum', we need to use an
 	     ;; expression that's not just a symbol.
-             :initform (symbol-value 'most-positive-fixnum)
+             :initform most-positive-fixnum
              :type integer
              :custom integer
              :documentation "The maximum number of registry entries.")
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 11ffc115f7..723d67ab5f 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -30,15 +30,16 @@
 (require 'eieio-opt)
 
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-macs))
 
 ;;; Code:
 ;; Set up some test classes
 (defclass class-a ()
   ((water :initarg :water
-	  :initform h20
+	  :initform 'h20
 	  :type symbol
 	  :documentation "Detail about water.")
-   (classslot :initform penguin
+   (classslot :initform 'penguin
 	      :type symbol
 	      :documentation "A class allocated slot."
 	      :allocation :class)
@@ -63,7 +64,7 @@ defclass class-ab (class-a class-b)
 
 (defclass class-c ()
   ((slot-1 :initarg :moose
-	   :initform moose
+	   :initform 'moose
 	   :type symbol
 	   :allocation :instance
 	   :documentation "First slot testing slot arguments."
@@ -82,7 +83,7 @@ defclass class-c ()
 	   :accessor get-slot-2
 	   :protection :private)
    (slot-3 :initarg :emu
-	   :initform emu
+	   :initform 'emu
 	   :type symbol
 	   :allocation :class
 	   :documentation "Third slot test class allocated accessor"
@@ -489,9 +490,9 @@ defvar eitest-pvinit nil)
 
 (defclass inittest nil
   ((staticval :initform 1)
-   (symval :initform eieio-test-permuting-value)
-   (evalval :initform (symbol-value 'eieio-test-permuting-value))
-   (evalnow :initform (symbol-value 'eieio-test-permuting-value)
+   (symval :initform 'eieio-test-permuting-value)
+   (evalval :initform eieio-test-permuting-value)
+   (evalnow :initform eieio-test-permuting-value
 	    :allocation :class)
    )
   "Test initforms that eval.")
@@ -555,6 +556,15 @@ defclass eitest-superior nil
     (should-not (cl-typep listooa '(list-of class-b)))
     (should-not (cl-typep listoob '(list-of class-a)))))
 
+(defclass eieio-tests-initargs-initform-interplay ()
+  ((slot-with-initarg-and-initform
+    :initarg :slot-with-initarg-and-initform
+    :initform 'value-specified-in-defclass-form)
+   (slot-with-initarg-only
+    :initarg :slot-with-initarg-only)
+   (slot-with-initform-only
+    :initform 'value-specified-in-defclass-form)))
+
 (defvar eitest-t1 nil)
 (ert-deftest eieio-test-25-slot-tests ()
   (setq eitest-t1 (class-c))
@@ -574,7 +584,70 @@ 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)
+  ;; Slot initialization according to initargs and initforms
+  (cl-macrolet
+      ((when-initargs (slots &rest noerrorp
+                             &key
+                             slot-with-initarg-and-initform
+                             slot-with-initarg-only
+                             slot-with-initform-only)
+         (cl-macrolet ((code-for
+                        (arg)
+                        `(let ((slot ,arg))
+                           (cl-case slot
+                             (unbound `(not (slot-boundp eitest-t1 ',',arg)))
+                             ((nil)
+                              ;; it would be cleaner
+                              ;; to introduce and check supplied-p arguments
+                              ;; but it's not worth the added complexity
+                              t)
+                             (t `(eq ,slot (oref eitest-t1 ,',arg)))))))
+           (let ((make-instance
+                  `(setq eitest-t1
+                         (make-instance
+                          'eieio-tests-initargs-initform-interplay
+                          ,@(cl-loop
+                             for initarg in slots
+                             collect initarg
+                             collect
+                             ''value-specified-in-make-instance-form)))))
+             (if noerrorp
+                 `(progn
+                    ,make-instance
+                    (should (and ,(code-for slot-with-initarg-and-initform)
+                                 ,(code-for slot-with-initarg-only)
+                                 ,(code-for slot-with-initform-only))))
+               `(should-error ,make-instance))))))
+    ;; Whenever slot without initarg is initialized by initarg, it's an error;
+    ;; see CLHS, 7.1.2 Declaring the Validity of Initialization Arguments.
+    ;; So, the following four should just error:
+    (when-initargs (:slot-with-initform-only))
+    (when-initargs (:slot-with-initform-only :slot-with-initarg-and-initform))
+    (when-initargs (:slot-with-initform-only :slot-with-initarg-only))
+    (when-initargs (:slot-with-initform-only :slot-with-initarg-and-initform
+                                             :slot-with-initarg-only))
+    ;; The rest should not.
+
+    (when-initargs (:slot-with-initarg-and-initform :slot-with-initarg-only)
+      :slot-with-initarg-and-initform 'value-specified-in-make-instance-form
+      :slot-with-initarg-only 'value-specified-in-make-instance-form
+      :slot-with-initform-only 'value-specified-in-defclass-form)
+
+    (when-initargs (:slot-with-initarg-and-initform)
+      :slot-with-initarg-and-initform 'value-specified-in-make-instance-form
+      :slot-with-initarg-only unbound
+      :slot-with-initform-only 'value-specified-in-defclass-form)
+
+    (when-initargs (:slot-with-initarg-only)
+      :slot-with-initarg-and-initform 'value-specified-in-defclass-form
+      :slot-with-initarg-only 'value-specified-in-make-instance-form
+      :slot-with-initform-only 'value-specified-in-defclass-form)
+
+    (when-initargs ()
+      :slot-with-initarg-and-initform 'value-specified-in-defclass-form
+      :slot-with-initarg-only unbound
+      :slot-with-initform-only 'value-specified-in-defclass-form)))
 
 (defvar eitest-t2 nil)
 (ert-deftest eieio-test-26-default-inheritance ()
@@ -696,7 +769,7 @@ defvar eitest-II3 nil)
   (setq eitest-II3 (clone eitest-II2 "eitest-II3 Test."))
   (oset eitest-II3 slot3 'penguin)
 
-  ;; Test that slots are non-initialized slots are unbounded
+  ;; Test that non-initialized slots are unbounded
   (oref eitest-II2 slot1)
   (should (slot-boundp eitest-II2 'slot1))
   (should-not (slot-boundp eitest-II2 'slot2))
@@ -715,7 +788,7 @@ defvar eitest-II3 nil)
   (should (eq (oref eitest-II3 slot3) 'penguin)))
 
 (defclass slotattr-base ()
-  ((initform :initform init)
+  ((initform :initform 'init)
    (type :type list)
    (initarg :initarg :initarg)
    (protection :protection :private)
@@ -730,7 +803,7 @@ defclass slotattr-base ()
 Subclasses to override slot attributes.")
 
 (defclass slotattr-ok (slotattr-base)
-  ((initform :initform no-init)
+  ((initform :initform 'no-init)
    (initarg :initarg :initblarg)
    (custom :custom string
 	   :label "One String"
@@ -766,7 +839,7 @@ defclass slotattr-ok (slotattr-base)
 
 (defclass slotattr-class-base ()
   ((initform :allocation :class
-	     :initform init)
+	     :initform 'init)
    (type :allocation :class
 	 :type list)
    (initarg :allocation :class
@@ -785,7 +858,7 @@ defclass slotattr-class-base ()
 Subclasses to override slot attributes.")
 
 (defclass slotattr-class-ok (slotattr-class-base)
-  ((initform :initform no-init)
+  ((initform :initform 'no-init)
    (initarg :initarg :initblarg)
    (custom :custom string
 	   :label "One String"
@@ -847,7 +920,7 @@ defvar eitest-CLONETEST2 nil)
   (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1))))
 
 (defclass IT (eieio-instance-tracker)
-  ((tracking-symbol :initform IT-list)
+  ((tracking-symbol :initform 'IT-list)
    (slot1 :initform 'die))
   "Instance Tracker test object.")
 
-- 
2.31.1

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

akater [2021-07-02 07:41:26] wrote:
> A version with correct code generation.  Tests pass on 27.

Sorry 'bout the delay.

> Replace :initform (symbol-value 'x) to :initform x everywhere.

This can't be right because it presumes the CLOS semantics which we
don't have yet: `:initform x` will use the symbol `x` rather than the
value of variable `x` as the default value (and it will emit a warning
because we don't want code to rely on this non-CLOS-compatible
semantics).

Hopefully we'll be able to do that in a few years, but we're not there yet.

> +(defclass eieio-tests-initargs-initform-interplay ()
> +  ((slot-with-initarg-and-initform
> +    :initarg :slot-with-initarg-and-initform
> +    :initform 'value-specified-in-defclass-form)
> +   (slot-with-initarg-only
> +    :initarg :slot-with-initarg-only)
> +   (slot-with-initform-only
> +    :initform 'value-specified-in-defclass-form)))

I don't understand how you can use this to test the interplay
between :initargs and :initform.

I thought this bug was about the fact that :iniform gets evaluated in
cases where it shouldn't, not about the final value in the object.
IOW it's about potential side-effects of evaluating :initform in cases
where we shouldn't.  But the above :initforms are all pure so I can't
see how it can test what we're after.

More to the point: the `eieio-test-25-slot-tests` extended as in your
patch passes successfully without your changes to eieio.el, so it's not
a proper regression test: we want a test that fails on the current code
and succeeds after we install your patch.

Another thing, in the patch you have:

    +(eval-when-compile (require 'cl-macs))

which is not only redundant with the (eval-when-compile (require 'cl-lib))
on the previous line, but makes assumptions about the way cl-lib is
split into files: always require `cl-lib` (rather than `cl-macs`,
`cl-extra`, etc...) when you need any part of it.


        Stefan

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[akater]

[-- Attachment #1.1: Type: text/plain, Size: 623 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> This can't be right because it presumes the CLOS semantics which we
> don't have yet: `:initform x` will use the symbol `x` rather than the
> value of variable `x` as the default value (and it will emit a warning
> because we don't want code to rely on this non-CLOS-compatible
> semantics).

Right.  I had to do it in Emacs 27 but it's implemented differently in
28, as should have been evident to me given the current code in
initialize-instance.

> we want a test that fails on the current code
> and succeeds after we install your patch.

OK; I replaced the tests.


[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix eval initform --]
[-- Type: text/x-diff, Size: 4781 bytes --]

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))
 
 \f
 ;;; 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

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>> we want a test that fails on the current code
>> and succeeds after we install your patch.
> OK; I replaced the tests.

Thanks, pushed to `master`.


        Stefan

bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform

[Lars Ingebrigtsen]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> Thanks, pushed to `master`.

And I'm closing the bug report, then.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no