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: Mon, 10 Jul 2017 21:45:05 -0400 Message-ID: <87mv8bg31a.fsf@users.sourceforge.net> References: <87h9075j12.fsf@users.sourceforge.net> <87injak1lj.fsf@users.sourceforge.net> <877ezp4v96.fsf@drachen> <871sppgyhb.fsf@users.sourceforge.net> <87fue5i1cp.fsf@drachen> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1499737459 17895 195.159.176.226 (11 Jul 2017 01:44:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 11 Jul 2017 01:44:19 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2.50 (gnu/linux) Cc: 27016@debbugs.gnu.org, Stefan Monnier , Rafael D Sorkin To: Michael Heerdegen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Jul 11 03:44: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 1dUkDj-00044s-6M for geb-bug-gnu-emacs@m.gmane.org; Tue, 11 Jul 2017 03:44:12 +0200 Original-Received: from localhost ([::1]:43712 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dUkDl-0000S2-FF for geb-bug-gnu-emacs@m.gmane.org; Mon, 10 Jul 2017 21:44:13 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37336) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dUkDe-0000Nx-3e for bug-gnu-emacs@gnu.org; Mon, 10 Jul 2017 21:44:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dUkDa-0004ZN-Uz for bug-gnu-emacs@gnu.org; Mon, 10 Jul 2017 21:44:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:58721) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dUkDa-0004Z9-PS for bug-gnu-emacs@gnu.org; Mon, 10 Jul 2017 21:44:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dUkDa-0006Cs-IP for bug-gnu-emacs@gnu.org; Mon, 10 Jul 2017 21:44: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: Tue, 11 Jul 2017 01:44: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.149973742223808 (code B ref 27016); Tue, 11 Jul 2017 01:44:02 +0000 Original-Received: (at 27016) by debbugs.gnu.org; 11 Jul 2017 01:43:42 +0000 Original-Received: from localhost ([127.0.0.1]:33163 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dUkDG-0006Bv-FD for submit@debbugs.gnu.org; Mon, 10 Jul 2017 21:43:42 -0400 Original-Received: from mail-it0-f68.google.com ([209.85.214.68]:34159) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dUkDE-0006Bj-VV for 27016@debbugs.gnu.org; Mon, 10 Jul 2017 21:43:41 -0400 Original-Received: by mail-it0-f68.google.com with SMTP id o202so912824itc.1 for <27016@debbugs.gnu.org>; Mon, 10 Jul 2017 18:43:40 -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=+AZHv5SQC/6aWtPToP3ZMCSZ68dQ1Oe9sG0XdfkjQwc=; b=S9YYz2L04TaKprmXgD8zdDeHoHEQ/XBj2xaNnB53iCqTzvQvo2Ch6tfWQrQpgyEHok GKqwmMn9QxJKkIHpk4ZO+MhoL7/yfJnk/Gtr6tf9uULkiZ7OuRgBktUcbU+ORmuv1qnA A3Lk+0dlTmR4FUx6oIAfvYNGTVvxEpZPtRqS8fDqTvKimEZV6KHA7X+SyUG+yMAlAoGM tE96P32f4snU8P15EfuEsejvu8TRLKRtBAG0WuBX9ZGB/BVxx1w7kCEvNKz1zo5wreN+ pSmXGaNNwglSKOe3I674L7xMpEnyEgS/rfNIy6e01DFy9EhUAgL2qAh2XEWsVsg47P2S hunA== 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=+AZHv5SQC/6aWtPToP3ZMCSZ68dQ1Oe9sG0XdfkjQwc=; b=boesU39kDZPIOHg3HMOa67mRY3zOSPYWM4w7JRm6QUYLqXCM4mzCS5/rFJYb0rf3o1 qDlV011Ft+cUHiU0KFwilFbK5rQGGDD9KX5wyd3IUA+754ShQj6euGrayCvPBwSouSyj YeUqo7Z01PEJM9gSN3Liq7mZFuGHcCx66Ukjox7iUYXBDID3b5qGVjfOfGdIcMcTIREj 2Hmlks425bGjUazoLwQMQ1cTPiO8L9nO7VAJsl7HgvIvIy5pJSyWnldeKHLvMuo5DQ6y JFWnLa2czoatBKKWUHAmaPuQ/VGY9u5SU7VKnzNU9OxejTr7oKH1EL3CreVRDsJkw6Ql jUxQ== X-Gm-Message-State: AIVw111AChR5+Ln82JattwJS2BcWB+O75mFlzLvAhhnK9w6Uj6UGPnD2 FBKxmk66RYIZWA== X-Received: by 10.36.67.9 with SMTP id s9mr13839296itb.6.1499737414406; Mon, 10 Jul 2017 18:43:34 -0700 (PDT) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id 95sm7040811ios.36.2017.07.10.18.43.32 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 10 Jul 2017 18:43:33 -0700 (PDT) In-Reply-To: <87fue5i1cp.fsf@drachen> (Michael Heerdegen's message of "Mon, 10 Jul 2017 02:26:14 +0200") 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:134416 Archived-At: --=-=-= Content-Type: text/plain Michael Heerdegen writes: > Is it intended to add an :gv-expanders entry to > byte-compile-macro-environment more than once? Hmm, not entirely consciously, I was following the same pattern I had used for cl-symbol-macrolet, but in that case we're establishing a let-binding so it's important to be able to pop back to the old binding. It's not needed here though. Also, I had a typo in gv-get (:gv-expands instead of :gv-expanders), because I didn't actually test the positive case. Here's a working(?) version, with tests: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=v2-0001-Don-t-define-gv-expanders-in-compiler-session-Bug.patch Content-Description: patch >From b48af25eb5c18cb45d9e431076df767718efa0ec Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Mon, 10 Jul 2017 21:42:05 -0400 Subject: [PATCH v2] Don't define gv expanders in compiler session (Bug#27016) This prevents definitions being compiled from leaking into the current Emacs doing the compilation. * lisp/emacs-lisp/gv.el (gv-define-expander): Push the expander definition into `byte-compile-macro-environment' instead of evaluating at compile time. (gv-get): Check `byte-compile-macro-environment' for gv-expander definitions. * test/lisp/emacs-lisp/gv-tests.el: New tests. --- lisp/emacs-lisp/gv.el | 23 ++++++--- test/lisp/emacs-lisp/gv-tests.el | 103 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 119 insertions(+), 7 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..fa8ae27e1f 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -91,7 +91,10 @@ (defun gv-get (place do) ((not (consp place)) (signal 'gv-invalid-place (list place))) (t (let* ((head (car place)) - (gf (function-get head 'gv-expander 'autoload))) + (gf (or (alist-get head (alist-get :gv-expanders + (bound-and-true-p + byte-compile-macro-environment))) + (function-get head 'gv-expander 'autoload)))) (if gf (apply gf do (cdr place)) (let ((me (macroexpand-1 place ;; (append macroexpand-all-environment @@ -146,12 +149,18 @@ (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))) + ;; Push onto `byte-compile-macro-environment' so the method can be + ;; used in the same file as it is defined. + (when (boundp 'byte-compile-macro-environment) + (let* ((expanders (assq :gv-expanders byte-compile-macro-environment)) + (expander (assq name (cdr expanders))) + (new-expander (cons name handler))) + (cond (expander (setcdr expander handler)) + (expanders (setcdr expanders (cons new-expander (cdr expanders)))) + (t (setq byte-compile-macro-environment + (cons (cons :gv-expanders (list new-expander)) + byte-compile-macro-environment)))))) + `(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 --=-=-=--