~ 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