summaryrefslogtreecommitdiff
path: root/test-suite/tests/compiler.test
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2021-04-27 14:51:38 +0200
committerAndy Wingo <wingo@pobox.com>2021-04-27 14:51:38 +0200
commit12fa7d115d24fa97879c5b6cde44e93a25221895 (patch)
tree995cf83033e472e96fc468039397b17583140719 /test-suite/tests/compiler.test
parent534dd35a3c3e842d8547e83c38e5b67e99af89b5 (diff)
downloadguile-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.test35
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)))))