The attached patch fixes a bug reported by Christian. The type-validation
of "deprecated" type-specifiers returned an incorrect value. Also, a small
bug in the type-database is fixed. 

This should go into 4.8.0, I think.
>From 74d8892ad71dd85ad58df549fc23f61cd2e147ba Mon Sep 17 00:00:00 2001
From: felix <[email protected]>
Date: Fri, 7 Sep 2012 23:47:51 +0200
Subject: [PATCH] Type-validation returned incorrect result for "deprecation" type-specifier.
 This also fixes a bug in types.db for "record-instance?"

Fixes #918.
---
 scrutinizer.scm |   28 +++++++++++++++-------------
 types.db        |    2 +-
 2 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 6e03660..765ea06 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -157,18 +157,18 @@
 	     (lambda (a) 
 	       (cond
 		((eq? a 'deprecated)
-		(report
-		 loc
-		 (sprintf "use of deprecated library procedure `~a'" id) )
-		'(*))
-	       ((and (pair? a) (eq? (car a) 'deprecated))
-		(report
-		 loc
-		 (sprintf 
-		     "use of deprecated library procedure `~a' - consider using `~a' instead"
-		   id (cadr a)))
-		'(*))
-	       (else (list a)))))
+		 (report
+		  loc
+		  (sprintf "use of deprecated library procedure `~a'" id) )
+		 '(*))
+		((and (pair? a) (eq? (car a) 'deprecated))
+		 (report
+		  loc
+		  (sprintf 
+		      "use of deprecated library procedure `~a' - consider using `~a' instead"
+		    id (cadr a)))
+		 '(*))
+		(else (list a)))))
 	    (else '(*))))
 
     (define (blist-type id flow)
@@ -1992,7 +1992,9 @@
 		  (symbol? (cadr t))
 		  t))
 	    ((eq? 'deprecated (car t))
-	     (and (= 2 (length t)) (symbol? (second t))))
+	     (and (= 2 (length t))
+		  (symbol? (second t))
+		  '*))
 	    ((or (memq '--> t) (memq '-> t)) =>
 	     (lambda (p)
 	       (let* ((cleanf (eq? '--> (car p)))
diff --git a/types.db b/types.db
index 0d8b8d2..84dbab0 100644
--- a/types.db
+++ b/types.db
@@ -1497,7 +1497,7 @@
 
 (procedure-data (#(procedure #:clean #:enforce) procedure-data (procedure) *))
 (record->vector (#(procedure #:clean) record->vector (*) vector))
-(record-instance? (#(procedure #:clean) record-instance? (*) boolean))
+(record-instance? (#(procedure #:clean) record-instance? (* #!optional symbol) boolean))
 (record-instance-length (#(procedure #:clean) record-instance-length (*) fixnum))
 (record-instance-slot (#(procedure #:clean #:enforce) record-instance-slot (* fixnum) *))
 (record-instance-slot-set! (#(procedure #:clean #:enforce) record-instance-slot-set! (* fixnum *) undefined))
-- 
1.7.0.4

_______________________________________________
Chicken-hackers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to