[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#27016: possible bug in `defsetf'
From: |
npostavs |
Subject: |
bug#27016: possible bug in `defsetf' |
Date: |
Sat, 15 Jul 2017 10:51:34 -0400 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.2.50 (gnu/linux) |
Stefan Monnier <monnier@IRO.UMontreal.CA> 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.
>From 8ae4c8b840070c025fc7a9b24ab7fcff38683191 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@IRO.UMontreal.CA>
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 <npostavs@gmail.com>
---
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
>From ee889d6bb0e36d8852ab122cfbcf2782dc12f74e Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
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 <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-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
- bug#27016: possible bug in `defsetf', (continued)
- bug#27016: possible bug in `defsetf', Stefan Monnier, 2017/07/11
- bug#27016: possible bug in `defsetf', npostavs, 2017/07/11
- bug#27016: possible bug in `defsetf', Stefan Monnier, 2017/07/11
- bug#27016: possible bug in `defsetf', npostavs, 2017/07/13
- bug#27016: possible bug in `defsetf', Stefan Monnier, 2017/07/13
- bug#27016: possible bug in `defsetf', npostavs, 2017/07/13
- bug#27016: possible bug in `defsetf', Stefan Monnier, 2017/07/13
- bug#27016: possible bug in `defsetf', Stefan Monnier, 2017/07/14
- bug#27016: possible bug in `defsetf',
npostavs <=
- bug#27016: possible bug in `defsetf', Stefan Monnier, 2017/07/15