procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Revert "Fix closure-conversion of shadowed captured lambda-lifted vars"

Browse source 
This reverts commit 3ec8c8b3ae.

It was committed to a stable branch without prior discussion;
see bug#53071.
This commit is contained in:
Mattias Engdegård 2022-01-12 19:47:39 +01:00
parent a1ac6bd47e
commit 22ddd2ba13
3 changed files with 6 additions and 220 deletions
Download patch file Download diff file Expand all files Collapse all files

43
test/lisp/emacs-lisp/bytecomp-tests.el
View file

@ -640,49 +640,6 @@ 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.")

152
test/lisp/emacs-lisp/cconv-tests.el
View file

@ -205,157 +205,5 @@
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