~ chicken-core (chicken-5) de033aef6860a4b76d388810e73d3927fd553e95

commit de033aef6860a4b76d388810e73d3927fd553e95
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jan 21 09:39:13 2011 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Jan 21 09:39:13 2011 +0100

    fix in scrutinizer after bug-report by alan

diff --git a/runtime.c b/runtime.c
index fa4c10a5..d6bf249e 100644
--- a/runtime.c
+++ b/runtime.c
@@ -3781,7 +3781,6 @@ C_regparm C_word C_fcall C_hash_string(C_word str)
   unsigned C_word key = 0;
   int len = C_header_size(str);
   C_byte *ptr = C_data_pointer(str);
-// *(ptr++) means you run off the edge.  
   while(len--) key = (key << 4) + (*ptr++);
 
   return C_fix(key & C_MOST_POSITIVE_FIXNUM);
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 0c2d77ba..5763099b 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -346,10 +346,10 @@
 		(case (car t1)
 		  ((or) (every (cut type<=? <> t2) (cdr t1)))
 		  ((procedure)
-		   (let ((args1 (if (pair? (cadr t1)) (cadr t1) (caddr t1)))
-			 (args2 (if (pair? (cadr t2)) (cadr t2) (caddr t2)))
-			 (res1 (if (pair? (cadr t1)) (cddr t1) (cdddr t1)))
-			 (res2 (if (pair? (cadr t2)) (cddr t2) (cdddr t2))) )
+		   (let ((args1 (if (named? t1) (caddr t1) (cadr t1)))
+			 (args2 (if (named? t2) (caddr t2) (cadr t2)))
+			 (res1 (if (named? t1) (cdddr t1) (cddr t1)))
+			 (res2 (if (named? t2) (cdddr t2) (cddr t2))) )
 		     (let loop1 ((args1 args1)
 				 (args2 args2)
 				 (m1 0) 
diff --git a/types.db b/types.db
index 6608d580..f2e9bceb 100644
--- a/types.db
+++ b/types.db
@@ -685,7 +685,7 @@
 (call-with-input-string (procedure call-with-input-string (string (procedure (port) . *)) . *))
 (call-with-output-string (procedure call-with-output-string ((procedure (port) . *)) string))
 (copy-port (procedure copy-port (* * #!optional (procedure (*) *) (procedure (* *) *)) undefined)) 
-(make-input-port (procedure make-input-port ((procedure () char) (procedure () *) (procedure () . *) #!optional * * *) port))
+(make-input-port (procedure make-input-port ((procedure () char) (procedure () *) (procedure () . *) #!optional * * * *) port))
 (make-output-port (procedure make-output-port ((procedure (string) . *) (procedure () . *) #!optional (procedure () . *)) port))
 (port-for-each (procedure port-for-each ((procedure (*) *) (procedure () . *)) undefined))
 (port-map (procedure port-map ((procedure (*) *) (procedure () . *)) list))