mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-02 10:16:19 +02:00
Code Activity

fix misallocation of some <fix> procedures

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-10-20 23:50:05 +02:00
parent 3e54fdfc21
commit aa9c198588
2 changed files with 14 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/language/tree-il/analyze.scm
View file

@ -171,7 +171,7 @@
;; returns variables referenced in expr ;; returns variables referenced in expr
(define (analyze! x proc labels-in-proc tail? tail-call-args) (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 y) (analyze! y proc labels-in-proc tail? #f))
(define (step-tail-call y args) (analyze! y proc labels-in-proc #f (define (step-tail-call y args) (analyze! y proc labels-in-proc #f
(and tail? args))) (and tail? args)))

13
test-suite/tests/tree-il.test
View file

@ -624,6 +624,19 @@
(toplevel ref bar) (call call/cc 1) (toplevel ref bar) (call call/cc 1)
(call tail-call 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" (with-test-prefix "partial evaluation"