diff options
Diffstat (limited to 'test/lisp/emacs-lisp/cconv-tests.el')
| -rw-r--r-- | test/lisp/emacs-lisp/cconv-tests.el | 158 |
1 files changed, 156 insertions, 2 deletions
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el index 5aeed0cc155..0701892b8c4 100644 --- a/test/lisp/emacs-lisp/cconv-tests.el +++ b/test/lisp/emacs-lisp/cconv-tests.el @@ -1,4 +1,4 @@ -;;; cconv-tests.el -*- lexical-binding: t -*- +;;; cconv-tests.el --- Tests for cconv.el -*- lexical-binding: t -*- ;; Copyright (C) 2018-2021 Free Software Foundation, Inc. @@ -19,6 +19,8 @@ ;;; Commentary: +;;; Code: + (require 'ert) (require 'cl-lib) @@ -203,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. +;;; cconv-tests.el ends here |