From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: npostavs@users.sourceforge.net Newsgroups: gmane.emacs.bugs Subject: bug#27016: possible bug in `defsetf' Date: Thu, 13 Jul 2017 00:46:18 -0400 Message-ID: <87a849djvp.fsf@users.sourceforge.net> References: <87h9075j12.fsf@users.sourceforge.net> <87injak1lj.fsf@users.sourceforge.net> <877ezp4v96.fsf@drachen> <871sppgyhb.fsf@users.sourceforge.net> <8760eyfp7s.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1499921118 22034 195.159.176.226 (13 Jul 2017 04:45:18 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Thu, 13 Jul 2017 04:45:18 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2.50 (gnu/linux) Cc: Michael Heerdegen , 27016@debbugs.gnu.org, Rafael D Sorkin To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Jul 13 06:45:14 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dVVzz-0005LQ-RX for geb-bug-gnu-emacs@m.gmane.org; Thu, 13 Jul 2017 06:45:12 +0200 Original-Received: from localhost ([::1]:57175 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dVW02-0001nU-Qq for geb-bug-gnu-emacs@m.gmane.org; Thu, 13 Jul 2017 00:45:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37747) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dVVzu-0001kz-Po for bug-gnu-emacs@gnu.org; Thu, 13 Jul 2017 00:45:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dVVzq-0000qo-QM for bug-gnu-emacs@gnu.org; Thu, 13 Jul 2017 00:45:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:33413) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dVVzq-0000qV-KX for bug-gnu-emacs@gnu.org; Thu, 13 Jul 2017 00:45:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dVVzq-0002cY-8U for bug-gnu-emacs@gnu.org; Thu, 13 Jul 2017 00:45:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 13 Jul 2017 04:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 27016 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 27016-submit@debbugs.gnu.org id=B27016.149992109610048 (code B ref 27016); Thu, 13 Jul 2017 04:45:02 +0000 Original-Received: (at 27016) by debbugs.gnu.org; 13 Jul 2017 04:44:56 +0000 Original-Received: from localhost ([127.0.0.1]:36090 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dVVzj-0002bx-TN for submit@debbugs.gnu.org; Thu, 13 Jul 2017 00:44:56 -0400 Original-Received: from mail-it0-f52.google.com ([209.85.214.52]:37284) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dVVzh-0002bj-7z for 27016@debbugs.gnu.org; Thu, 13 Jul 2017 00:44:53 -0400 Original-Received: by mail-it0-f52.google.com with SMTP id m84so32867626ita.0 for <27016@debbugs.gnu.org>; Wed, 12 Jul 2017 21:44:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=AYCPDTcFY6f6ugrymaaY7G18ftI+MLhZsVHqW0XT1d0=; b=lricbqiavf6bLV3OVgMRlJmRYQdJJm5W56Dg3PDG4W/uNYzoH3XtGLZW5apTHXVmaO /KXlGq+zSbecKbhdRDW7uTQKSvmLH4UlpBHu4vLipBchZA/STaPFL3T3EP4a+Tca383H 9e7eFxCg4IHuWGk+28tzP0PMFFrVbJVKocuWRpTPdrCUdPAm7wr5bA9ZIxGRXxFmIRC1 6uxZjnCqFrZggW+fqPmCkWDCesZemOxdzWhJ9R6TBVsHL3ZhdAXn3pHidgRcGC0RR+YQ bV2bjpBbMgDGsfzHM+FOsyrNcC9RtD4TF7byixRHxuRgceKrRDWbH2Ot82UGRQdS6fUM t12A== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=AYCPDTcFY6f6ugrymaaY7G18ftI+MLhZsVHqW0XT1d0=; b=MgTNeKG7AwYPxd7CmMAv3AC4haV0v18DyTGBidF9A1V9nClrNRJstF7ZYe4wdWr655 5IAM/AVOfja7JT7Befbh0RF7rXeyEX4zw9TgofunNLy/hHtQ/+ZvRT1IYm1YwlRrPmby M02jNvBndr0FVivShFmNT1Qou0m/gRKiqJ9ID28zMEA0zYeD8S7QgS3PPpUJUKl0HbJT fspsWOFAr6V4gpq/+GbGYoFz4ah4nau2QzLyOAs+JjkRw9x3FwLaEg0ioVm8nA9Rtqxd 8m75t6wCHu7oIzM2hhEm2uonPk2Tz16RKE24EGKpaVNtnloZfSNPTFx5kKOIwJe8l45L +SrQ== X-Gm-Message-State: AIVw112SunKXqN97EKCJ1lHomhW4GOkL9BZsT3nYHhrBybDKjOjf7zb7 mnbB7w+zW0hsQg== X-Received: by 10.36.110.23 with SMTP id w23mr26270659itc.24.1499921087308; Wed, 12 Jul 2017 21:44:47 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id b17sm428906itd.0.2017.07.12.21.44.44 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 12 Jul 2017 21:44:45 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Tue, 11 Jul 2017 22:01:14 -0400") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 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.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:134496 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: > I don't know what to do when a macro calls it (I can't think of any > reason we'd want to do that), but I know how to handle the case where > a macro outputs code that uses it: Add (byte-defop-compiler-1 > function-put) as well as a byte-compile-function-put function. > See byte-compile-autoload and byte-compile-make-obsolete-variable > for examples. Oh, I think I get it now. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=v3-0001-Let-function-put-affect-compilation-of-the-curren.patch Content-Description: patch >From 565dd64e74b78f56982bd7ca92f34ab71e6d669a Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 13 Jul 2017 00:40:35 -0400 Subject: [PATCH v3 1/2] Let `function-put' affect compilation of the current file * lisp/emacs-lisp/bytecomp.el (byte-compile-plist-environment): New variable. (byte-compile-close-variables): Let-bind it to nil. (byte-compile-function-put): New byte-defop-compiler. * lisp/subr.el (function-get): Consult `byte-compile-plist-environment'. --- lisp/emacs-lisp/bytecomp.el | 18 ++++++++++++++++++ lisp/subr.el | 7 ++++++- 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e5b9b47b1d..028efbce26 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -498,6 +498,10 @@ (defvar byte-compile-macro-environment byte-compile-initial-macro-environment Each element looks like (MACRONAME . DEFINITION). It is \(MACRONAME . nil) when a macro is redefined as a function.") +(defvar byte-compile-plist-environment nil + "Alist of property lists defined in the file being compiled. +Each element looks like (SYMBOL . PLIST).") + (defvar byte-compile-function-environment nil "Alist of functions defined in the file being compiled. This is so we can inline them when necessary. @@ -1585,6 +1589,7 @@ (defmacro byte-compile-close-variables (&rest body) ;; macroenvironment. (copy-alist byte-compile-initial-macro-environment)) (byte-compile--outbuffer nil) + (byte-compile-plist-environment nil) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) (byte-compile-lexical-variables nil) @@ -4577,6 +4582,7 @@ (byte-defop-compiler-1 defvar) (byte-defop-compiler-1 defconst byte-compile-defvar) (byte-defop-compiler-1 autoload) (byte-defop-compiler-1 lambda byte-compile-lambda-form) +(byte-defop-compiler-1 function-put) ;; If foo.el declares `toto' as obsolete, it is likely that foo.el will ;; actually use `toto' in order for this obsolete variable to still work @@ -4725,6 +4731,18 @@ (put 'make-variable-buffer-local 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local) (defun byte-compile-form-make-variable-buffer-local (form) (byte-compile-keep-pending form 'byte-compile-normal-call)) + +(defun byte-compile-function-put (form) + (pcase form + (`(,_ (,(or 'quote 'function) ,(and fun (guard (symbolp fun)))) + ',prop ,(or `#',value (and value (guard (functionp value))))) + (let ((fplist (assq fun byte-compile-plist-environment))) + (if fplist + (setcdr fplist (plist-put (cdr fplist) prop value)) + (push (cons fun (list prop value)) + byte-compile-plist-environment))))) + (byte-compile-normal-call form)) + ;;; tags diff --git a/lisp/subr.el b/lisp/subr.el index 42b4e1c211..3e4a3dedf5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2971,7 +2971,12 @@ (defun function-get (f prop &optional autoload) if it's an autoloaded macro." (let ((val nil)) (while (and (symbolp f) - (null (setq val (get f prop))) + (null (setq val (or (plist-get + (alist-get + f (bound-and-true-p + byte-compile-plist-environment)) + prop) + (get f prop)))) (fboundp f)) (let ((fundef (symbol-function f))) (if (and autoload (autoloadp fundef) -- 2.11.1 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=v3-0002-Don-t-define-gv-expanders-in-compiler-s-runtime-B.patch Content-Description: patch >From bb2165c72cc7fa436ab911ab756cacec6384927d Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 13 Jul 2017 00:42:38 -0400 Subject: [PATCH v3 2/2] Don't define gv expanders in compiler's runtime (Bug#27016) This prevents definitions being compiled from leaking into the current Emacs doing the compilation. * lisp/emacs-lisp/gv.el (gv-define-expander): Use function-put instead of `put' with `eval-and-compile'. * test/lisp/emacs-lisp/gv-tests.el: New tests. --- lisp/emacs-lisp/gv.el | 7 +-- test/lisp/emacs-lisp/gv-tests.el | 103 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 104 insertions(+), 6 deletions(-) create mode 100644 test/lisp/emacs-lisp/gv-tests.el diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index c5c12a6414..54105f89af 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -146,12 +146,7 @@ (defmacro gv-define-expander (name handler) HANDLER is a function which takes an argument DO followed by the same arguments as NAME. DO is a function as defined in `gv-get'." (declare (indent 1) (debug (sexp form))) - ;; Use eval-and-compile so the method can be used in the same file as it - ;; is defined. - ;; FIXME: Just like byte-compile-macro-environment, we should have something - ;; like byte-compile-symbolprop-environment so as to handle these things - ;; cleanly without affecting the running Emacs. - `(eval-and-compile (put ',name 'gv-expander ,handler))) + `(function-put ',name 'gv-expander ,handler)) ;;;###autoload (defun gv--defun-declaration (symbol name args handler &optional fix) diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el new file mode 100644 index 0000000000..affc7ce455 --- /dev/null +++ b/test/lisp/emacs-lisp/gv-tests.el @@ -0,0 +1,103 @@ +;;; gv-tests.el --- tests for gv.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(eval-when-compile (require 'cl-lib)) + +(cl-defmacro gv-tests--in-temp-dir ((elvar elcvar) + (&rest filebody) + &rest body) + (declare (indent 2)) + `(let ((default-directory (make-temp-file "gv-test" t))) + (unwind-protect + (let ((,elvar "gv-test-deffoo.el") + (,elcvar "gv-test-deffoo.elc")) + (with-temp-file ,elvar + (insert ";; -*- lexical-binding: t; -*-\n") + (dolist (form ',filebody) + (pp form (current-buffer)))) + ,@body) + (delete-directory default-directory t)))) + +(ert-deftest gv-define-expander-in-file () + (gv-tests--in-temp-dir (el elc) + ((gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) "99\n"))))) + +(ert-deftest gv-dont-define-expander-in-file () + ;; The expander is defined while we are compiling the file, even + ;; though it's inside (when nil ...). + :expected-result :failed + (gv-tests--in-temp-dir (el elc) + ((when nil (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval))) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) + "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n"))))) + +(ert-deftest gv-define-expander-out-of-file () + (gv-tests--in-temp-dir (el elc) + ((gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + (defvar gv-test-pair (cons 1 2))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc + "--eval" + (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))))) + (should (equal (buffer-string) "99\n"))))) + +(ert-deftest gv-dont-define-expander-other-file () + (gv-tests--in-temp-dir (el elc) + ((if nil (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval))) + (defvar gv-test-pair (cons 1 2))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc + "--eval" + (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))))) + (should (equal (buffer-string) + "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n"))))) + +;;; gv-tests.el ends here -- 2.11.1 --=-=-=--