~ chicken-core (chicken-5) ca990ee483c2de61228079b4e7e8b704f7f3b98c

commit ca990ee483c2de61228079b4e7e8b704f7f3b98c
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Aug 5 09:33:17 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Aug 5 09:33:17 2011 +0200

    fixed bug in gp optimizuation (reported by Sven Hartrumpf)

diff --git a/optimizer.scm b/optimizer.scm
index 5f74d41b..dd380cc2 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -231,7 +231,7 @@
 		      (let ((gvar (cdr a)))
 			(cond ((and gvar
 				    (not (eq? 'no (variable-mark gvar '##compiler#inline))))
-			       (debugging 'x "propagated global variable" var gvar)
+			       (debugging 'o "propagated global variable" var gvar)
 			       (varnode gvar))
 			      (else (varnode var))))))
 		   (else (varnode var)))))
@@ -463,7 +463,15 @@
 		    (make-node '##core#undefined '() '()) )
 		   (else
 		    (let ((n2 (make-node 'set! params (list (walk (car subs) fids gae)))))
-		      (cond ((assq var gae) => (cut set-cdr! <> #f)))
+		      (for-each
+		       (if (test var 'global)
+			   (lambda (a)
+			     (when (eq? var (cdr a)) ; assignment to alias?
+			       (set-cdr! a #f)))
+			   (lambda (a)
+			     (when (eq? var (car a))
+			       (set-cdr! a #f))))
+		       gae)
 		      n2)))))
 
 	  (else (walk-generic n class params subs fids gae #f)) ) ) )
diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
index 6b7432fc..73951302 100644
--- a/tests/compiler-tests.scm
+++ b/tests/compiler-tests.scm
@@ -200,4 +200,19 @@
     (define (baz)
       (bar a: #t))
     baz)
-  bar)
\ No newline at end of file
+  bar)
+
+
+;; global-propagation must also invalidate alias to global if global
+;; itself is assigned (reported by Sven Hartrumpf)
+
+(define gp-test-global 0)
+
+(define (gp-test)
+  (let ((a gp-test-global)
+	(b gp-test-global))
+    (set! gp-test-global 1)
+    (assert (zero? a))
+    (assert (zero? b))))
+
+(gp-test)