From aa9c19858872a135ea959066fff26f86527a1bd0 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 20 Oct 2011 23:50:05 +0200 Subject: [PATCH] fix misallocation of some 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. --- module/language/tree-il/analyze.scm | 2 +- test-suite/tests/tree-il.test | 13 +++++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) 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 @@ -624,6 +624,19 @@ (toplevel ref bar) (call call/cc 1) (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"