mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 18:40:39 -08:00
Fix closure-conversion of shadowed captured lambda-lifted vars
Lambda-lifted variables (ones passed explicitly to lambda-lifted
functions) that are also captured in an outer closure and shadowed
were renamed incorrectly (bug#51982).
Reported by Paul Pogonyshev.
* lisp/emacs-lisp/cconv.el (cconv--lifted-arg): New.
(cconv-convert): Provide correct definiens for the closed-over
variable.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases):
* test/lisp/emacs-lisp/cconv-tests.el (cconv-tests--intern-all)
(cconv-closure-convert-remap-var): Add tests.
(cherry picked from commit 45252ad8f9)
This commit is contained in:
Mattias Engdegård
parent
862faa64e5
commit
3ec8c8b3ae
3 changed files with 220 additions and 6 deletions
|
|
@ -640,6 +640,49 @@ inner loops respectively."
|
|||
(f (list (lambda (x) (setq a x)))))
|
||||
(funcall (car f) 3)
|
||||
(list a b))
|
||||
|
||||
;; These expressions give different results in lexbind and dynbind modes,
|
||||
;; but in each the compiler and interpreter should agree!
|
||||
;; (They look much the same but come in pairs exercising both the
|
||||
;; `let' and `let*' paths.)
|
||||
(let ((f (lambda (x)
|
||||
(lambda ()
|
||||
(let ((g (lambda () x)))
|
||||
(let ((x 'a))
|
||||
(list x (funcall g))))))))
|
||||
(funcall (funcall f 'b)))
|
||||
(let ((f (lambda (x)
|
||||
(lambda ()
|
||||
(let ((g (lambda () x)))
|
||||
(let* ((x 'a))
|
||||
(list x (funcall g))))))))
|
||||
(funcall (funcall f 'b)))
|
||||
(let ((f (lambda (x)
|
||||
(lambda ()
|
||||
(let ((g (lambda () x)))
|
||||
(setq x (list x x))
|
||||
(let ((x 'a))
|
||||
(list x (funcall g))))))))
|
||||
(funcall (funcall f 'b)))
|
||||
(let ((f (lambda (x)
|
||||
(lambda ()
|
||||
(let ((g (lambda () x)))
|
||||
(setq x (list x x))
|
||||
(let* ((x 'a))
|
||||
(list x (funcall g))))))))
|
||||
(funcall (funcall f 'b)))
|
||||
(let ((f (lambda (x)
|
||||
(let ((g (lambda () x))
|
||||
(h (lambda () (setq x (list x x)))))
|
||||
(let ((x 'a))
|
||||
(list x (funcall g) (funcall h)))))))
|
||||
(funcall (funcall f 'b)))
|
||||
(let ((f (lambda (x)
|
||||
(let ((g (lambda () x))
|
||||
(h (lambda () (setq x (list x x)))))
|
||||
(let* ((x 'a))
|
||||
(list x (funcall g) (funcall h)))))))
|
||||
(funcall (funcall f 'b)))
|
||||
)
|
||||
"List of expressions for cross-testing interpreted and compiled code.")
|
||||
|
||||
|
|
|
|||
|
|
@ -205,5 +205,157 @@
|
|||
nil 99)
|
||||
42)))
|
||||
|
||||
(defun cconv-tests--intern-all (x)
|
||||
"Intern all symbols in X."
|
||||
(cond ((symbolp x) (intern (symbol-name x)))
|
||||
((consp x) (cons (cconv-tests--intern-all (car x))
|
||||
(cconv-tests--intern-all (cdr x))))
|
||||
;; Assume we don't need to deal with vectors etc.
|
||||
(t x)))
|
||||
|
||||
(ert-deftest cconv-closure-convert-remap-var ()
|
||||
;; Verify that we correctly remap shadowed lambda-lifted variables.
|
||||
|
||||
;; We intern all symbols for ease of comparison; this works because
|
||||
;; the `cconv-closure-convert' result should contain no pair of
|
||||
;; distinct symbols having the same name.
|
||||
|
||||
;; Sanity check: captured variable, no lambda-lifting or shadowing:
|
||||
(should (equal (cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
#'(lambda () x))))
|
||||
'#'(lambda (x)
|
||||
(internal-make-closure
|
||||
nil (x) nil
|
||||
(internal-get-closed-var 0)))))
|
||||
|
||||
;; Basic case:
|
||||
(should (equal (cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
(let ((f #'(lambda () x)))
|
||||
(let ((x 'b))
|
||||
(list x (funcall f)))))))
|
||||
'#'(lambda (x)
|
||||
(let ((f #'(lambda (x) x)))
|
||||
(let ((x 'b)
|
||||
(closed-x x))
|
||||
(list x (funcall f closed-x)))))))
|
||||
(should (equal (cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
(let ((f #'(lambda () x)))
|
||||
(let* ((x 'b))
|
||||
(list x (funcall f)))))))
|
||||
'#'(lambda (x)
|
||||
(let ((f #'(lambda (x) x)))
|
||||
(let* ((closed-x x)
|
||||
(x 'b))
|
||||
(list x (funcall f closed-x)))))))
|
||||
|
||||
;; With the lambda-lifted shadowed variable also being captured:
|
||||
(should (equal
|
||||
(cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
#'(lambda ()
|
||||
(let ((f #'(lambda () x)))
|
||||
(let ((x 'a))
|
||||
(list x (funcall f))))))))
|
||||
'#'(lambda (x)
|
||||
(internal-make-closure
|
||||
nil (x) nil
|
||||
(let ((f #'(lambda (x) x)))
|
||||
(let ((x 'a)
|
||||
(closed-x (internal-get-closed-var 0)))
|
||||
(list x (funcall f closed-x))))))))
|
||||
(should (equal
|
||||
(cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
#'(lambda ()
|
||||
(let ((f #'(lambda () x)))
|
||||
(let* ((x 'a))
|
||||
(list x (funcall f))))))))
|
||||
'#'(lambda (x)
|
||||
(internal-make-closure
|
||||
nil (x) nil
|
||||
(let ((f #'(lambda (x) x)))
|
||||
(let* ((closed-x (internal-get-closed-var 0))
|
||||
(x 'a))
|
||||
(list x (funcall f closed-x))))))))
|
||||
;; With lambda-lifted shadowed variable also being mutably captured:
|
||||
(should (equal
|
||||
(cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
#'(lambda ()
|
||||
(let ((f #'(lambda () x)))
|
||||
(setq x x)
|
||||
(let ((x 'a))
|
||||
(list x (funcall f))))))))
|
||||
'#'(lambda (x)
|
||||
(let ((x (list x)))
|
||||
(internal-make-closure
|
||||
nil (x) nil
|
||||
(let ((f #'(lambda (x) (car-safe x))))
|
||||
(setcar (internal-get-closed-var 0)
|
||||
(car-safe (internal-get-closed-var 0)))
|
||||
(let ((x 'a)
|
||||
(closed-x (internal-get-closed-var 0)))
|
||||
(list x (funcall f closed-x)))))))))
|
||||
(should (equal
|
||||
(cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
#'(lambda ()
|
||||
(let ((f #'(lambda () x)))
|
||||
(setq x x)
|
||||
(let* ((x 'a))
|
||||
(list x (funcall f))))))))
|
||||
'#'(lambda (x)
|
||||
(let ((x (list x)))
|
||||
(internal-make-closure
|
||||
nil (x) nil
|
||||
(let ((f #'(lambda (x) (car-safe x))))
|
||||
(setcar (internal-get-closed-var 0)
|
||||
(car-safe (internal-get-closed-var 0)))
|
||||
(let* ((closed-x (internal-get-closed-var 0))
|
||||
(x 'a))
|
||||
(list x (funcall f closed-x)))))))))
|
||||
;; Lambda-lifted variable that isn't actually captured where it is shadowed:
|
||||
(should (equal
|
||||
(cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
(let ((g #'(lambda () x))
|
||||
(h #'(lambda () (setq x x))))
|
||||
(let ((x 'b))
|
||||
(list x (funcall g) (funcall h)))))))
|
||||
'#'(lambda (x)
|
||||
(let ((x (list x)))
|
||||
(let ((g #'(lambda (x) (car-safe x)))
|
||||
(h #'(lambda (x) (setcar x (car-safe x)))))
|
||||
(let ((x 'b)
|
||||
(closed-x x))
|
||||
(list x (funcall g closed-x) (funcall h closed-x))))))))
|
||||
(should (equal
|
||||
(cconv-tests--intern-all
|
||||
(cconv-closure-convert
|
||||
'#'(lambda (x)
|
||||
(let ((g #'(lambda () x))
|
||||
(h #'(lambda () (setq x x))))
|
||||
(let* ((x 'b))
|
||||
(list x (funcall g) (funcall h)))))))
|
||||
'#'(lambda (x)
|
||||
(let ((x (list x)))
|
||||
(let ((g #'(lambda (x) (car-safe x)))
|
||||
(h #'(lambda (x) (setcar x (car-safe x)))))
|
||||
(let* ((closed-x x)
|
||||
(x 'b))
|
||||
(list x (funcall g closed-x) (funcall h closed-x))))))))
|
||||
)
|
||||
|
||||
(provide 'cconv-tests)
|
||||
;;; cconv-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue