From: npostavs@users.sourceforge.net
To: Michael Heerdegen <michael_heerdegen@web.de>
Cc: 27016@debbugs.gnu.org, Stefan Monnier <monnier@iro.umontreal.ca>,
Rafael D Sorkin <rsorkin@perimeterinstitute.ca>
Subject: bug#27016: possible bug in `defsetf'
Date: Mon, 10 Jul 2017 21:45:05 -0400 [thread overview]
Message-ID: <87mv8bg31a.fsf@users.sourceforge.net> (raw)
In-Reply-To: <87fue5i1cp.fsf@drachen> (Michael Heerdegen's message of "Mon, 10 Jul 2017 02:26:14 +0200")
[-- Attachment #1: Type: text/plain, Size: 556 bytes --]
Michael Heerdegen <michael_heerdegen@web.de> 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:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 7685 bytes --]
From b48af25eb5c18cb45d9e431076df767718efa0ec Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
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 <http://www.gnu.org/licenses/>.
+
+;;; 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
next prev parent reply other threads:[~2017-07-11 1:45 UTC|newest]
Thread overview: 42+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-05-22 6:39 bug#27016: possible bug in `defsetf' Rafael D Sorkin
2017-05-22 12:11 ` npostavs
2017-05-22 20:25 ` Rafael D Sorkin
2017-05-22 21:18 ` npostavs
2017-05-22 23:10 ` Michael Heerdegen
2017-05-22 23:23 ` npostavs
2017-05-23 0:45 ` Michael Heerdegen
2017-05-23 0:51 ` npostavs
2017-05-23 1:18 ` Michael Heerdegen
2017-05-22 22:03 ` Rafael D Sorkin
2017-05-22 23:15 ` npostavs
2017-05-24 4:52 ` Rafael D Sorkin
2017-05-24 22:51 ` Michael Heerdegen
2017-05-25 1:50 ` npostavs
2017-05-25 4:59 ` Rafael D Sorkin
2017-05-25 5:01 ` Rafael D Sorkin
2017-05-25 10:38 ` npostavs
2017-05-25 20:26 ` Michael Heerdegen
2017-05-25 20:42 ` Noam Postavsky
2017-05-25 21:31 ` Michael Heerdegen
2017-05-25 23:03 ` npostavs
2017-05-25 23:40 ` Michael Heerdegen
2017-05-26 3:50 ` Stefan Monnier
2017-05-26 22:51 ` npostavs
2017-05-28 20:45 ` Stefan Monnier
2017-07-02 20:47 ` npostavs
2017-07-03 11:25 ` Michael Heerdegen
2017-07-09 20:13 ` npostavs
2017-07-10 0:26 ` Michael Heerdegen
2017-07-11 1:45 ` npostavs [this message]
2017-07-11 16:21 ` Stefan Monnier
2017-07-12 0:55 ` npostavs
2017-07-12 2:01 ` Stefan Monnier
2017-07-13 4:46 ` npostavs
2017-07-13 14:25 ` Stefan Monnier
2017-07-14 0:39 ` npostavs
2017-07-14 3:48 ` Stefan Monnier
2017-07-14 4:32 ` Stefan Monnier
2017-07-15 14:51 ` npostavs
2017-07-16 1:03 ` Stefan Monnier
2017-08-08 1:18 ` npostavs
2017-05-26 5:05 ` Rafael D Sorkin
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87mv8bg31a.fsf@users.sourceforge.net \
--to=npostavs@users.sourceforge.net \
--cc=27016@debbugs.gnu.org \
--cc=michael_heerdegen@web.de \
--cc=monnier@iro.umontreal.ca \
--cc=rsorkin@perimeterinstitute.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).