From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: akater Newsgroups: gmane.emacs.bugs Subject: bug#49291: [akater] [PATCH] lisp/emacs-lisp/eieio.el (initialize-instance): Fix initform Date: Mon, 12 Jul 2021 18:32:09 +0000 Message-ID: <87fswjcriu.fsf@gmail.com> References: <875yxvuwtf.fsf@gmail.com> <8735sxmac9.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="38539"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 49291@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Jul 12 20:44:12 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1m30uZ-0009nq-5f for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 12 Jul 2021 20:44:11 +0200 Original-Received: from localhost ([::1]:43800 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1m30uY-0003aP-4N for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 12 Jul 2021 14:44:10 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:38262) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m30uQ-0003aH-MW for bug-gnu-emacs@gnu.org; Mon, 12 Jul 2021 14:44:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:55558) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1m30uQ-0001XS-AV for bug-gnu-emacs@gnu.org; Mon, 12 Jul 2021 14:44:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1m30uQ-00077T-4g for bug-gnu-emacs@gnu.org; Mon, 12 Jul 2021 14:44:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: akater Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 12 Jul 2021 18:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 49291 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 49291-submit@debbugs.gnu.org id=B49291.162611540727317 (code B ref 49291); Mon, 12 Jul 2021 18:44:02 +0000 Original-Received: (at 49291) by debbugs.gnu.org; 12 Jul 2021 18:43:27 +0000 Original-Received: from localhost ([127.0.0.1]:38871 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m30tr-00076X-C2 for submit@debbugs.gnu.org; Mon, 12 Jul 2021 14:43:27 -0400 Original-Received: from mail-qv1-f54.google.com ([209.85.219.54]:43795) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m30tp-00076J-If for 49291@debbugs.gnu.org; Mon, 12 Jul 2021 14:43:26 -0400 Original-Received: by mail-qv1-f54.google.com with SMTP id i4so8560387qvq.10 for <49291@debbugs.gnu.org>; Mon, 12 Jul 2021 11:43:25 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=nfRoSFc7PDEDqwv9Sblf5Ge7xlfksq11yCI2H1RhUP4=; b=p5e49ZqbosyQdCUD0pRuc000gjDod08X6/Z3FkGf9FkVe1EF9GJ8IzXMEc+mqqDnfH QhpEh/UuQ4SoAtA+0VKLznGPMuQFf+Fy36YEFvdlz71DqRpUzelvKPcXxdejOPP1DR0q s/jNd+evSfkAa92i/HTcfOFIQJ8a+UYusRJM5GtNUXZ4ayLPxSoC2709euR68rt2wd8h hAbVG+OoxjUGMfCDzQeH2nYcTDULzXSkf8U9aK5SKvBJVd+Tz2PHXsYfjhQVyj6Eh4fm ey1HJ8pXyObR5xgiLj5OY3D1nvsB8LFTe+YhWNSQbLtQwSum/zw+4fmBaIcH1NEyDZsS hi+Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=nfRoSFc7PDEDqwv9Sblf5Ge7xlfksq11yCI2H1RhUP4=; b=qv+ABNp+pjT/a9CIhVj9BXWA3r3l4YiRO+Q33q+K5PeZfQ+GrR5jv7lSOYpTSEG3Ve hBv4d/18fdK7zR8PGKOkNE2yVhkFmgrA42Q1VlMpxeQNYU34XpNZ97292pWbkx6FliYD l37d2sn8sseau/kVqV5KkQQk9Gn0DiXN0C+wzovbYewjZ5hiXK+k0s2VN90Bsc9qJZIV uyX7mFHvStln59kPv7f79Ag1z3nOxR/W7P+arO4UsJySzEtAZm8lGgDCAGMNoLJG5Ywb D01fB0ET4GBOW2FqtqQp7ZDTo0lAYsLo40hZVLKp8zw7wKOLb11TCWw0UBW4KJgt8Z71 2oiw== X-Gm-Message-State: AOAM530+2ktbY1Fd+m2Tit42cBMjlZrP5RvW7DTm7wJV1HpCAOAk2wZ/ pqnmio2PcYtnr+cpaWHcisDK1e/ARaY= X-Google-Smtp-Source: ABdhPJx8Aan8Iat9rbmKF0/Owsg8w9iGXen3zMJBIz0bB/G+c91AEuD7rqEn6HL2gxr+SXD0dvgHvg== X-Received: by 2002:a0c:d845:: with SMTP id i5mr402702qvj.32.1626115399877; Mon, 12 Jul 2021 11:43:19 -0700 (PDT) Original-Received: from localhost (tor-exit-fr.letztermensch.com. [51.210.80.127]) by smtp.googlemail.com with ESMTPSA id v5sm6836441qkh.39.2021.07.12.11.43.18 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 12 Jul 2021 11:43:19 -0700 (PDT) In-Reply-To: X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:209837 Archived-At: --=-=-= Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" --==-=-= Content-Type: text/plain Stefan Monnier 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. --==-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJLBAEBCgA1FiEEgu5SJRdnQOF34djNsr6xYbHsf0QFAmDsiqsXHG51Y2xlYXJz cGFjZUBnbWFpbC5jb20ACgkQsr6xYbHsf0SDdg/+LrZyRuLd8wmncRaKHwc0JTfI H9v7BkFou8yuLRSMso/VRvDis2CMD0Iy59S5l9avDE9mRhmdJaZMgyaMra0YIWIA JtqxgVuDbTZQArfAKFdrpze9Pf3NDV7RwuULWmCGcDpiyFGsR6XULtSsiKJ7ZYuL mQUgn1sgThiF8XsRWWNKWUCexxtjFhmuDKknyJ8wxAtna7mw3gVMOgcxxdpebtCO sfHgq9yPqSoQOOw7nL7i3JDDXyyYU5ExrNcR3FwgueR54Yeni82Hfozxii4EKe2E DQa+D6jL6l1WG4P9NJgmJ4QeU7dgnHEMjaSbprEz7gird6MofSHrNOLatVWsWgXH cMVacp+UEWRA0TPRwJe2X1ZZF1khxm4OLceMYBSNDLwkiDrXAcZvJecJ4hJrAWeM m3qMzgFuzfPrjnCshQISUGXtxYeGIHdEsIKXg6ZffaXD78O+le1Q+fspVqoOjw4C ErlCU+z9kJVq93JDFosjaZ8yCmgjH+pac24fTv8zoo962jnhzjp25lQF2wERzgCy 1KtYMxR5JMkq9oRsGyNxm8UuJnEA4S4KUqYT8GW27WZsXjGrUnFSUvz5xB09rxKT 2omYJRGyuIRKt8GJZPOJm01lab443TR9k/R/6cI9C1RKNNvESBsN+SK79cfDKn9d skl9GYeQ2t8y3YWvFUA= =gXgS -----END PGP SIGNATURE----- --==-=-=-- --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Prevent-excessive-evaluation-of-initform.patch Content-Description: Fix eval initform >From 75990f852a03436f84bd42f9ce22975a6b0c166a Mon Sep 17 00:00:00 2001 From: akater 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 ) 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 --=-=-=--