mirror of
https://github.com/masscollaborationlabs/emacs.git
synced 2025-07-04 11:23:24 +00:00
Don't rely on dynamic scoping to fix bug#59213
Rather than look up a dynamically scoped var to decide whether to trim closures, use an ad-hoc marker on those closures which should not be trimmed. * lisp/emacs-lisp/cconv.el (cconv-dont-trim-unused-variables): Delete var. (cconv-make-interpreted-closure): Use a `:closure-dont-trim-context` markers instead. * lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper): Use `:closure-dont-trim-context` rather than `cconv-dont-trim-unused-variables`. * lisp/emacs-lisp/testcover.el (testcover-analyze-coverage): Remove workaround for `cconv-dont-trim-unused-variables`. * test/lisp/emacs-lisp/cconv-tests.el (cconv-safe-for-space): New test.
This commit is contained in:
parent
2ac8d7e64a
commit
750bc57cbb
4 changed files with 34 additions and 21 deletions
|
@ -113,10 +113,6 @@ is less than this number.")
|
||||||
(defvar cconv--dynbound-variables nil
|
(defvar cconv--dynbound-variables nil
|
||||||
"List of variables known to be dynamically bound.")
|
"List of variables known to be dynamically bound.")
|
||||||
|
|
||||||
(defvar cconv-dont-trim-unused-variables nil
|
|
||||||
"When bound to non-nil, don't remove unused variables from the environment.
|
|
||||||
This is intended for use by edebug and similar.")
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun cconv-closure-convert (form &optional dynbound-vars)
|
(defun cconv-closure-convert (form &optional dynbound-vars)
|
||||||
"Main entry point for closure conversion.
|
"Main entry point for closure conversion.
|
||||||
|
@ -882,15 +878,22 @@ lexically and dynamically bound symbols actually used by FORM."
|
||||||
(cons fvs dyns)))))
|
(cons fvs dyns)))))
|
||||||
|
|
||||||
(defun cconv-make-interpreted-closure (fun env)
|
(defun cconv-make-interpreted-closure (fun env)
|
||||||
|
;; FIXME: I don't know what "This function is evaluated both at
|
||||||
|
;; compile time and run time" is intended to mean here.
|
||||||
"Make a closure for the interpreter.
|
"Make a closure for the interpreter.
|
||||||
This function is evaluated both at compile time and run time.
|
This function is evaluated both at compile time and run time.
|
||||||
FUN, the closure's function, must be a lambda form.
|
FUN, the closure's function, must be a lambda form.
|
||||||
ENV, the closure's environment, is a mixture of lexical bindings of the form
|
ENV, the closure's environment, is a mixture of lexical bindings of the form
|
||||||
(SYMBOL . VALUE) and symbols which indicate dynamic bindings of those
|
\(SYMBOL . VALUE) and symbols which indicate dynamic bindings of those
|
||||||
symbols."
|
symbols."
|
||||||
(cl-assert (eq (car-safe fun) 'lambda))
|
(cl-assert (eq (car-safe fun) 'lambda))
|
||||||
(let ((lexvars (delq nil (mapcar #'car-safe env))))
|
(let ((lexvars (delq nil (mapcar #'car-safe env))))
|
||||||
(if (or cconv-dont-trim-unused-variables (null lexvars))
|
(if (or (null lexvars)
|
||||||
|
;; Functions with a `:closure-dont-trim-context' marker
|
||||||
|
;; should keep their whole context untrimmed (bug#59213).
|
||||||
|
(and (eq :closure-dont-trim-context (nth 2 fun))
|
||||||
|
;; Check the function doesn't just return the magic keyword.
|
||||||
|
(nthcdr 3 fun)))
|
||||||
;; The lexical environment is empty, or needs to be preserved,
|
;; The lexical environment is empty, or needs to be preserved,
|
||||||
;; so there's no need to look for free variables.
|
;; so there's no need to look for free variables.
|
||||||
;; Attempting to replace ,(cdr fun) by a macroexpanded version
|
;; Attempting to replace ,(cdr fun) by a macroexpanded version
|
||||||
|
|
|
@ -1217,16 +1217,18 @@ purpose by adding an entry to this alist, and setting
|
||||||
(setq edebug-old-def-name nil))
|
(setq edebug-old-def-name nil))
|
||||||
(setq edebug-def-name
|
(setq edebug-def-name
|
||||||
(or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
|
(or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
|
||||||
`(let ((cconv-dont-trim-unused-variables t))
|
`(edebug-enter
|
||||||
(edebug-enter
|
(quote ,edebug-def-name)
|
||||||
(quote ,edebug-def-name)
|
,(if edebug-inside-func
|
||||||
,(if edebug-inside-func
|
`(list
|
||||||
`(list
|
;; Doesn't work with more than one def-body!!
|
||||||
;; Doesn't work with more than one def-body!!
|
;; But the list will just be reversed.
|
||||||
;; But the list will just be reversed.
|
,@(nreverse edebug-def-args))
|
||||||
,@(nreverse edebug-def-args))
|
'nil)
|
||||||
'nil)
|
;; Make sure `forms' is not nil so we don't accidentally return
|
||||||
(function (lambda () ,@forms)))))
|
;; the magic keyword. Mark the closure so we don't throw away
|
||||||
|
;; unused vars (bug#59213).
|
||||||
|
#'(lambda () :closure-dont-trim-context ,@(or forms '(nil)))))
|
||||||
|
|
||||||
|
|
||||||
(defvar edebug-form-begin-marker) ; the mark for def being instrumented
|
(defvar edebug-form-begin-marker) ; the mark for def being instrumented
|
||||||
|
|
|
@ -442,11 +442,6 @@ or return multiple values."
|
||||||
(let ((testcover-vector (get sym 'edebug-coverage)))
|
(let ((testcover-vector (get sym 'edebug-coverage)))
|
||||||
(testcover-analyze-coverage-progn body)))
|
(testcover-analyze-coverage-progn body)))
|
||||||
|
|
||||||
(`(let ((cconv-dont-trim-unused-variables t))
|
|
||||||
(edebug-enter ',sym ,_ (function (lambda nil . ,body))))
|
|
||||||
(let ((testcover-vector (get sym 'edebug-coverage)))
|
|
||||||
(testcover-analyze-coverage-progn body)))
|
|
||||||
|
|
||||||
(`(edebug-after ,(and before-form
|
(`(edebug-after ,(and before-form
|
||||||
(or `(edebug-before ,before-id) before-id))
|
(or `(edebug-before ,before-id) before-id))
|
||||||
,after-id ,wrapped-form)
|
,after-id ,wrapped-form)
|
||||||
|
|
|
@ -364,5 +364,18 @@
|
||||||
(call-interactively f))
|
(call-interactively f))
|
||||||
'((t 51696) (nil 51695) (t 51697)))))))
|
'((t 51696) (nil 51695) (t 51697)))))))
|
||||||
|
|
||||||
|
(ert-deftest cconv-safe-for-space ()
|
||||||
|
(let* ((magic-string "This-is-a-magic-string")
|
||||||
|
(safe-p (lambda (x) (not (string-match magic-string (format "%S" x))))))
|
||||||
|
(should (funcall safe-p (lambda (x) (+ x 1))))
|
||||||
|
(should (funcall safe-p (eval '(lambda (x) (+ x 1))
|
||||||
|
`((y . ,magic-string)))))
|
||||||
|
(should (funcall safe-p (eval '(lambda (x) :closure-dont-trim-context)
|
||||||
|
`((y . ,magic-string)))))
|
||||||
|
(should-not (funcall safe-p
|
||||||
|
(eval '(lambda (x) :closure-dont-trim-context (+ x 1))
|
||||||
|
`((y . ,magic-string)))))))
|
||||||
|
|
||||||
|
|
||||||
(provide 'cconv-tests)
|
(provide 'cconv-tests)
|
||||||
;;; cconv-tests.el ends here
|
;;; cconv-tests.el ends here
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue