~ 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 xTrap