diff options
author | Andy Wingo <wingo@pobox.com> | 2021-04-27 14:51:38 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2021-04-27 14:51:38 +0200 |
commit | 12fa7d115d24fa97879c5b6cde44e93a25221895 (patch) | |
tree | 995cf83033e472e96fc468039397b17583140719 /test-suite/tests/compiler.test | |
parent | 534dd35a3c3e842d8547e83c38e5b67e99af89b5 (diff) | |
download | guile-12fa7d115d24fa97879c5b6cde44e93a25221895.tar.gz |
Fix closure-conversion bug for SCC with all free vars pruned
* module/language/cps/closure-conversion.scm (convert-one): Fix bug when
getting value of SCC whose free variables have been elided. Thanks to
abcdw for the report!
* test-suite/tests/compiler.test ("cse auxiliary definitions"): Remove
spurious newline.
("closure conversion"): New test.
Diffstat (limited to 'test-suite/tests/compiler.test')
-rw-r--r-- | test-suite/tests/compiler.test | 35 |
1 files changed, 33 insertions, 2 deletions
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test index dc75d0ac7..90eee491b 100644 --- a/test-suite/tests/compiler.test +++ b/test-suite/tests/compiler.test @@ -1,5 +1,5 @@ ;;;; compiler.test --- tests for the compiler -*- scheme -*- -;;;; Copyright (C) 2008-2014, 2018 Free Software Foundation, Inc. +;;;; Copyright (C) 2008-2014, 2018, 2021 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -315,7 +315,6 @@ (loop (+ i 1) (thunk))) (else (unless (= result 42) (error "bad result" result)) - (newline) result)))) (define (test n) (let ((matrix (make-vector n))) @@ -337,3 +336,35 @@ (pass-if-equal "test terminates without error" 42 (test-proc))) +(with-test-prefix "closure conversion" + (define test-code + '(lambda (arg) + (define (A a) + (let loop ((ls a)) + (cond ((null? ls) + (B a)) + ((pair? ls) + (if (list? (car ls)) + (loop (cdr ls)) + #t)) + (else #t)))) + (define (B b) + (let loop ((ls b)) + (cond ((null? ls) + (map A b)) + ((pair? ls) + (if (list? (car ls)) + (loop (cdr ls)) + (error "bad" b))) + (else + (error "bad" b))))) + (B arg))) + + (define test-proc #f) + (pass-if "compiling test works" + (begin + (set! test-proc (compile test-code)) + (procedure? test-proc))) + + (pass-if-equal "test terminates without error" '(#t #t) + (test-proc '((V X) (Y Z))))) |