~ chicken-core (chicken-5) ce80916d63b7aefe77ad35bff4401a8c811a2a59


commit ce80916d63b7aefe77ad35bff4401a8c811a2a59
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Oct 13 09:41:38 2012 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Oct 13 09:41:38 2012 +0200

    type-matching in reduce-typeset must be exact

diff --git a/scrutinizer.scm b/scrutinizer.scm
index b4f4b3dd..3cfbe93c 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -456,7 +456,7 @@
 			    (and-let* ((t2 (rec (third t))))
 			      `(forall ,(second t) ,t2)))
 			   ((or) 
-			    `(or ,@(remove (cut match-types <> pt typeenv) (cdr t))))
+			    `(or ,@(remove (cut match-types <> pt typeenv #t) (cdr t))))
 			   (else #f))))))
 	(simplify-type tnew)))
 
diff --git a/tests/scrutiny-tests-3.scm b/tests/scrutiny-tests-3.scm
index 243a069a..75c88f88 100644
--- a/tests/scrutiny-tests-3.scm
+++ b/tests/scrutiny-tests-3.scm
@@ -23,6 +23,13 @@
       (compiler-typecase x
 	(string 2))))
 
+(let ((x (the (or string number) something)))
+  (if (fixnum? x)
+      (compiler-typecase x
+	(fixnum 1))
+      (compiler-typecase x
+	((or string number) 2))))
+
 (let ((x (the (forall ((a string) (b number)) (or a b)) something)))
   (if (number? x)
       (compiler-typecase x
Trap