diff options
author | Andy Wingo <wingo@pobox.com> | 2011-10-20 23:50:05 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-10-20 23:50:05 +0200 |
commit | aa9c19858872a135ea959066fff26f86527a1bd0 (patch) | |
tree | 8f65a5f08a0504404439ffef056639f762295fd8 | |
parent | 3e54fdfc217969abb50a46ec9c9c5c02a2c7d369 (diff) | |
download | guile-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.scm | 2 | ||||
-rw-r--r-- | test-suite/tests/tree-il.test | 13 |
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 |