~ chicken-core (chicken-5) 56299cdc71ccbc6342b4614014536b715ff3747c

commit 56299cdc71ccbc6342b4614014536b715ff3747c
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Sep 26 08:34:10 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Sep 26 08:34:10 2011 +0200

    added some testcases

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 176129b3..3f9ebfd3 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2307,7 +2307,7 @@
 				   (else '())))
 			   insts)))
 		       vars)))
-	(dd "  collected: ~s" all)	;XXX remove
+	;;(dd "  collected: ~s" all)	;XXX remove
 	all))
 
     (dd " over-all-instantiations: ~s exact=~a" tlist exact) ;XXX remove
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 3e4b759a..6b687c8b 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -1,7 +1,7 @@
 ;;;; typematch-tests.scm
 
 
-(use lolevel)
+(use lolevel data-structures)
 
 
 (define-syntax check
@@ -213,10 +213,10 @@
 	((or fixnum symbol) 'sf))))
 
 (: f3 (forall (a) ((list-of a) -> a)))
-(define (f3 x) (car x))
+(define f3 car)
 (define xxx '(1))
 
-(compiler-typecase (foo (the (or (vector-of fixnum) (list-of fixnum)) xxx))
+(compiler-typecase (f3 (the (or (vector-of fixnum) (list-of fixnum)) xxx))
   (fixnum 'ok))
 
 (assert
@@ -224,3 +224,15 @@
       (compiler-typecase (list 123)
 	((forall (a) (or (vector-of a) (list-of a))) 'ok)
 	(else 'not-ok))))
+
+(: f4 (forall (a) ((or fixnum (list-of a)) -> a)))
+(define f4 identity)
+
+(compiler-typecase (f4 '(1))
+  (fixnum 'ok))
+
+(assert
+ (eq? 'ok (compiler-typecase (f4 1)
+	    (fixnum 'not-ok)
+	    (else 'ok))))
+