summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-10-20 23:50:05 +0200
committerAndy Wingo <wingo@pobox.com>2011-10-20 23:50:05 +0200
commitaa9c19858872a135ea959066fff26f86527a1bd0 (patch)
tree8f65a5f08a0504404439ffef056639f762295fd8
parent3e54fdfc217969abb50a46ec9c9c5c02a2c7d369 (diff)
downloadguile-aa9c19858872a135ea959066fff26f86527a1bd0.tar.gz
fix misallocation of some <fix> procedures
* module/language/tree-il/analyze.scm (analyze-lexicals): When stepping into a non-tail form, we know that labels allocation will be invalid, so use an empty labels set. Fixes http://debbugs.gnu.org/9769. * test-suite/tests/tree-il.test ("labels allocation"): Add a test.
-rw-r--r--module/language/tree-il/analyze.scm2
-rw-r--r--test-suite/tests/tree-il.test13
2 files changed, 14 insertions, 1 deletions
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 34f45c18d..990994a1e 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -171,7 +171,7 @@
;; returns variables referenced in expr
(define (analyze! x proc labels-in-proc tail? tail-call-args)
- (define (step y) (analyze! y proc labels-in-proc #f #f))
+ (define (step y) (analyze! y proc '() #f #f))
(define (step-tail y) (analyze! y proc labels-in-proc tail? #f))
(define (step-tail-call y args) (analyze! y proc labels-in-proc #f
(and tail? args)))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 8b4c900c3..011fef5a4 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -625,6 +625,19 @@
(call tail-call 1))))
+(with-test-prefix "labels allocation"
+ (pass-if "http://debbugs.gnu.org/9769"
+ ((compile '(lambda ()
+ (let ((fail (lambda () #f)))
+ (let ((test (lambda () (fail))))
+ (test))
+ #t))
+ ;; Prevent inlining. We're testing analyze.scm's
+ ;; labels allocator here, and inlining it will
+ ;; reduce the entire thing to #t.
+ #:opts '(#:partial-eval? #f)))))
+
+
(with-test-prefix "partial evaluation"
(pass-if-peval