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: Sat, 15 Jul 2017 10:51:34 -0400 Message-ID: <87y3rpda89.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> <87a849djvp.fsf@users.sourceforge.net> <874lufets0.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1500130276 10368 195.159.176.226 (15 Jul 2017 14:51:16 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 15 Jul 2017 14:51:16 +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 Sat Jul 15 16:51:10 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 1dWOPT-0002DG-5V for geb-bug-gnu-emacs@m.gmane.org; Sat, 15 Jul 2017 16:51:07 +0200 Original-Received: from localhost ([::1]:42330 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dWOPY-0001D2-NR for geb-bug-gnu-emacs@m.gmane.org; Sat, 15 Jul 2017 10:51:12 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58929) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dWOPR-0001Cm-KD for bug-gnu-emacs@gnu.org; Sat, 15 Jul 2017 10:51:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dWOPO-0002V5-Di for bug-gnu-emacs@gnu.org; Sat, 15 Jul 2017 10:51:05 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:37805) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dWOPO-0002Uz-7x for bug-gnu-emacs@gnu.org; Sat, 15 Jul 2017 10:51:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dWOPN-0007zG-U2 for bug-gnu-emacs@gnu.org; Sat, 15 Jul 2017 10:51:01 -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: Sat, 15 Jul 2017 14:51:01 +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.150013021130643 (code B ref 27016); Sat, 15 Jul 2017 14:51:01 +0000 Original-Received: (at 27016) by debbugs.gnu.org; 15 Jul 2017 14:50:11 +0000 Original-Received: from localhost ([127.0.0.1]:40482 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dWOOZ-0007yB-2S for submit@debbugs.gnu.org; Sat, 15 Jul 2017 10:50:11 -0400 Original-Received: from mail-io0-f177.google.com ([209.85.223.177]:33923) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dWOOW-0007xw-3T for 27016@debbugs.gnu.org; Sat, 15 Jul 2017 10:50:09 -0400 Original-Received: by mail-io0-f177.google.com with SMTP id r36so26671709ioi.1 for <27016@debbugs.gnu.org>; Sat, 15 Jul 2017 07:50:08 -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=mRIJ8V2Eash7b0geNL01Avzr/jvnt+SYbxydGKzIa7w=; b=Agxnt1lPpvjRzk0sxZIbtSUI+95eDNUEAhSLlM1rHJYPtK8jqOiyAIH2LjyrtGAXUa m2Qu68MZY3Q9vG0UNTcE5nd5iX5ujk/+VWGwkZu/9AmE87QMnJkADWnDnjTQG00lS9FQ CpUifmO2lrIEmVQCOXTxCLfls9G6eULFeCXOHsUUQpA6kFi2P/bd6zoQB3+5cli8CKLY T6A4+DfGiEnpzdKrhJ75ANzqVPohG8sIx745lWhUv4A/yLICIwCXUep3DrQ4aRQKFDrH TSHtZJc79caajpnPjJdW179Pq9wjWHt9JP8JBLPHMwbXYSULvIYotKIFbz5V7FUbqyMm 9UiQ== 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=mRIJ8V2Eash7b0geNL01Avzr/jvnt+SYbxydGKzIa7w=; b=mEBkAOhFpY8XjiPauA+ekjubUhlrBru+Qyy6X0+PzFKu88WHizce5z4VYE1h1wOS30 AiPkv2GAydTQALn6ZsAqUAkL7Tveel89PlRe1eJM9G5Cl/cNOrgKAU5bzNGHr48TMofJ NAMqYx3c9iUJO2SuVOMr5b9KEqD9boJWHdj+0ewr7uul5EiefZCLhPLOC8+U++Fk8Ju1 M4m7fzwvqNuZrmad8arvv0SdOczyVrZyW8MsiB3J3K/8RXyMNeJDRAR05404XevVsWAe FcTjhe9mQliDxyJEhMNMfzRfKCkw2g0hN6ulE8EtHnAeiiHqMfJockeS4pITQK/60rd+ 0dmw== X-Gm-Message-State: AIVw111FeuHei7VLD7tyje1NNOJKOTSNIUlPdwrxxOVX5mvwG8sx9RXw NuYShgavMGk/Tg== X-Received: by 10.107.53.25 with SMTP id c25mr12257725ioa.123.1500130202178; Sat, 15 Jul 2017 07:50:02 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id w68sm6318867iow.55.2017.07.15.07.50.00 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sat, 15 Jul 2017 07:50:00 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Fri, 14 Jul 2017 00:32:34 -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:134589 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: > @@ -4695,7 +4700,7 @@ byte-compile-file-form-defalias > (if (null fun) > (message "Macro %s unrecognized, won't work in file" name) > (message "Macro %s partly recognized, trying our luck" name) > - (push (cons name (eval fun)) > + (push (cons name (eval fun t)) What does this do? Should it be `lexical-binding' instead of `t'? > + (push (cons fun `(,prop ,val > + . ,(assq fun byte-compile-plist-environment))) That should be alist-get instead of assq. I've fixed that and added a test for it. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=v4-0001-Let-function-put-take-effect-during-compilation.patch Content-Description: patch >From 8ae4c8b840070c025fc7a9b24ab7fcff38683191 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 14 Jul 2017 00:32:34 -0400 Subject: [PATCH v4 1/2] Let function-put take effect during compilation * lisp/emacs-lisp/bytecomp.el (byte-compile-plist-environment): New variable. * lisp/emacs-lisp/bytecomp.el (byte-compile--outbuffer): Let-bind it to nil. * lisp/emacs-lisp/bytecomp.el (byte-compile-function-put): New function, handles compilation of top-level `function-put' calls. * lisp/subr.el (function-get): Consult byte-compile-plist-environment. Co-authored-by: Noam Postavsky --- lisp/emacs-lisp/bytecomp.el | 34 +++++++++++++++++++++++++++++++++- lisp/subr.el | 7 ++++++- test/lisp/emacs-lisp/bytecomp-tests.el | 17 +++++++++++++++++ 3 files changed, 56 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index fdd4276e4e..ee474f9527 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. @@ -1572,6 +1576,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) @@ -4682,7 +4687,7 @@ (defun byte-compile-file-form-defalias (form) (if (null fun) (message "Macro %s unrecognized, won't work in file" name) (message "Macro %s partly recognized, trying our luck" name) - (push (cons name (eval fun)) + (push (cons name (eval fun t)) byte-compile-macro-environment))) (byte-compile-keep-pending form)))) @@ -4712,6 +4717,33 @@ (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)) + +(put 'function-put 'byte-hunk-handler 'byte-compile-function-put) +(defun byte-compile-function-put (form) + (pcase form + ((and `(,op ,fun ,prop ,val) + (guard (and (macroexp-const-p fun) + (macroexp-const-p prop) + (or (macroexp-const-p val) + ;; Also accept anonymous functions, since + ;; we're at top-level which implies they're + ;; also constants. + (pcase val (`(function (lambda . ,_)) t)))))) + (byte-compile-push-constant op) + (byte-compile-form fun) + (byte-compile-form prop) + (let* ((fun (eval fun t)) + (prop (eval prop t)) + (val (if (macroexp-const-p val) + (eval val t) + (byte-compile-lambda (cadr val))))) + (push `(,fun + . (,prop ,val ,@(alist-get fun byte-compile-plist-environment))) + byte-compile-plist-environment) + (byte-compile-push-constant val) + (byte-compile-out 'byte-call 3))) + + (_ (byte-compile-keep-pending form)))) ;;; tags diff --git a/lisp/subr.el b/lisp/subr.el index a9edff6166..0c7e52c7a7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2962,7 +2962,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) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index d15bd8b6e6..8ef2ce7025 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -545,6 +545,23 @@ (ert-deftest bytecomp-tests--old-style-backquotes () This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual."))))))) + +(ert-deftest bytecomp-tests-function-put () + "Check `function-put' operates during compilation." + (should (boundp 'lread--old-style-backquotes)) + (bytecomp-tests--with-temp-file source + (dolist (form '((function-put 'bytecomp-tests--foo 'foo 1) + (function-put 'bytecomp-tests--foo 'bar 2) + (defmacro bytecomp-tests--foobar () + `(cons ,(function-get 'bytecomp-tests--foo 'foo) + ,(function-get 'bytecomp-tests--foo 'bar))) + (defvar bytecomp-tests--foobar 1) + (setq bytecomp-tests--foobar (bytecomp-tests--foobar)))) + (print form (current-buffer))) + (write-region (point-min) (point-max) source nil 'silent) + (byte-compile-file source t) + (should (equal bytecomp-tests--foobar (cons 1 2))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: -- 2.11.1 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=v4-0002-Don-t-define-gv-expanders-in-compiler-s-runtime-B.patch Content-Description: patch >From ee889d6bb0e36d8852ab122cfbcf2782dc12f74e Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 13 Jul 2017 00:42:38 -0400 Subject: [PATCH v4 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 | 140 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 141 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..b15a3de8cc --- /dev/null +++ b/test/lisp/emacs-lisp/gv-tests.el @@ -0,0 +1,140 @@ +;;; 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-define-expander-in-file-twice () + (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) + (gv-define-setter gv-test-foo (newval cons) + `(setcdr ,cons ,newval)) + (setf (gv-test-foo gv-test-pair) 42) + (message "%S" 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 . 42)\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 ...) because the compiler won't + ;; analyze the conditional. + :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-in-function () + ;; The expander is not defined while we are compiling the file, the + ;; compiler won't handle gv definitions not at top-level. + :expected-result :failed + (gv-tests--in-temp-dir (el elc) + ((defun foo () + (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + t) + (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-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 --=-=-=--