~ chicken-core (chicken-5) d127450d6e574427a3dccf1531e908135eed2bac

commit d127450d6e574427a3dccf1531e908135eed2bac
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sat Apr 21 00:13:49 2012 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Apr 21 15:59:15 2012 +0200

    Two types.db fixes:
    
    - finite?, exact? and inexact? raise an error on non-numbers.  They are not pure predicates and shouldn't be rewritten to "pure" C functions.
    - The "base" (aka "radix") argument for string->number and number->string can only be a fixnum.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 1268bd46..fab5f002 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -2,6 +2,10 @@
 
 (use srfi-1 extras)
 
+(define-syntax assert-fail
+  (syntax-rules ()
+    ((_ exp)
+     (assert (handle-exceptions ex #t exp #f)))))
 
 ;; numbers
 
@@ -20,6 +24,7 @@
 (assert (= 1.0 (round 0.6)))
 (assert (rational? 1))
 (assert (finite? 1))
+(assert-fail (finite? 'foo))
 (assert (rational? 1.0))
 (assert (finite? 1.0))
 (assert (not (rational? +inf.0)))
@@ -40,10 +45,14 @@
 (assert (not (integer? "foo")))
 ; XXX number missing
 
-(define-syntax assert-fail
-  (syntax-rules ()
-    ((_ exp)
-     (assert (handle-exceptions ex #t exp #f)))))
+(assert (exact? 1))
+(assert (not (exact? 1.0)))
+(assert (not (exact? 1.1)))
+(assert-fail (exact? 'foo))
+(assert (not (inexact? 1)))
+(assert (inexact? 1.0))
+(assert (inexact? 1.1))
+(assert-fail (inexact? 'foo))
 
 (assert-fail (/ 1 1 0))
 (assert-fail (/ 1 1 0.0))
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 4bea4dfe..1985dac1 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -59,14 +59,6 @@ Note: at toplevel:
   (scrutiny-tests-2.scm:23) in procedure call to `fixnum?', the predicate is called with an argument of type
   `float' and will always return false
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:24) in procedure call to `exact?', the predicate is called with an argument of type
-  `fixnum' and will always return true
-
-Note: at toplevel:
-  (scrutiny-tests-2.scm:24) in procedure call to `exact?', the predicate is called with an argument of type
-  `float' and will always return false
-
 Note: at toplevel:
   (scrutiny-tests-2.scm:25) in procedure call to `flonum?', the predicate is called with an argument of type
   `float' and will always return true
@@ -75,14 +67,6 @@ Note: at toplevel:
   (scrutiny-tests-2.scm:25) in procedure call to `flonum?', the predicate is called with an argument of type
   `fixnum' and will always return false
 
-Note: at toplevel:
-  (scrutiny-tests-2.scm:26) in procedure call to `inexact?', the predicate is called with an argument of type
-  `float' and will always return true
-
-Note: at toplevel:
-  (scrutiny-tests-2.scm:26) in procedure call to `inexact?', the predicate is called with an argument of type
-  `fixnum' and will always return false
-
 Note: at toplevel:
   (scrutiny-tests-2.scm:27) in procedure call to `number?', the predicate is called with an argument of type
   `fixnum' and will always return true
diff --git a/types.db b/types.db
index 7aed56f9..61a3dd1f 100644
--- a/types.db
+++ b/types.db
@@ -218,10 +218,14 @@
 	  ((fixnum) (let ((#(tmp) #(1))) '#t))
 	  ((float) (##core#inline "C_u_i_fpintegerp" #(1))))
 
-(exact? (#(procedure #:pure #:predicate fixnum) exact? (*) boolean))
 (real? (#(procedure #:pure #:predicate number) real? (*) boolean))
 (complex? (#(procedure #:pure #:predicate number) complex? (*) boolean))
-(inexact? (#(procedure #:pure #:predicate float) inexact? (*) boolean))
+(exact? (#(procedure #:clean #:enforce) exact? (number) boolean)
+        ((fixnum) (let ((#(tmp) #(1))) '#t))
+        ((float) (let ((#(tmp) #(1))) '#f)))
+(inexact? (#(procedure #:clean #:enforce) inexact? (number) boolean)
+          ((fixnum) (let ((#(tmp) #(1))) '#f))
+          ((float) (let ((#(tmp) #(1))) '#t)))
 
 ;;XXX predicate?
 (rational? (#(procedure #:pure) rational? (*) boolean)
@@ -474,10 +478,10 @@
 			       #(2)))
       ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1) #(2))))
 
-(number->string (#(procedure #:clean #:enforce) number->string (number #!optional number) string)
+(number->string (#(procedure #:clean #:enforce) number->string (number #!optional fixnum) string)
 		((fixnum) (##sys#fixnum->string #(1))))
 
-(string->number (#(procedure #:clean #:enforce) string->number (string #!optional number) 
+(string->number (#(procedure #:clean #:enforce) string->number (string #!optional fixnum) 
 		 (or number boolean)))
 
 (char? (#(procedure #:pure #:predicate char) char? (*) boolean))
@@ -802,9 +806,9 @@
 (file-exists? (#(procedure #:clean #:enforce) file-exists? (string) (or boolean string)))
 (directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string) (or boolean string)))
 
-(finite? (#(procedure #:pure) finite? (*) boolean)
+(finite? (#(procedure #:clean #:enforce) finite? (number) boolean)
 	 ((fixnum) (let ((#(tmp) #(1))) '#t))
-	 ((*) (##core#inline "C_i_finitep" #(1))))
+	 (((or float number)) (##core#inline "C_i_finitep" #(1))))
 
 (fixnum-bits fixnum)
 (fixnum-precision fixnum)