~ chicken-core (chicken-5) 4a0e63573fa0d9f5d77b6201ac91624201c952dd

commit 4a0e63573fa0d9f5d77b6201ac91624201c952dd
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sun Mar 11 20:52:01 2012 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Mar 12 15:25:52 2012 +0100

    Ensure library-tests are compiled to catch specialization errors more easily; fix several of those found this way
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 7a491a07..49b91ca5 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -1,12 +1,14 @@
 ;;;; library-tests.scm
 
-(use srfi-1)
+(use srfi-1 extras)
 
 
 ;; numbers
 
 (assert (= -4.0 (round -4.3)))
+(assert (= -4.0 (round -4.5)))          ; R5RS
 (assert (= 4.0 (round 3.5)))
+(assert (= 4.0 (round 4.5)))            ; R5RS
 (assert (= 4 (round (string->number "7/2"))))
 (assert (= 7 (round 7)))
 (assert (zero? (round -0.5))) 		; is actually -0.0
@@ -84,6 +86,8 @@
 (assert (= (acos 0.5) (fpacos 0.5)))
 (assert (= (atan 0.5) (fpatan 0.5)))
 (assert (= (atan 42.0 1.2) (fpatan2 42.0 1.2)))
+(assert (= (atan 42.0 1) (fpatan2 42.0 1.0)))
+(assert (= (atan 42 1.0) (fpatan2 42.0 1.0)))
 (assert (= (exp 42.0) (fpexp 42.0)))
 (assert (= (log 42.0) (fplog 42.0)))
 (assert (= (expt 42.0 3.5) (fpexpt 42.0 3.5)))
@@ -248,7 +252,7 @@
        (assert (= 2 (p)))
        k))))
 
-(k #f)
+(and k (k #f))
 
 (assert (= 2 guard-called))
 
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 88891faa..be161342 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -103,6 +103,10 @@ if errorlevel 1 exit /b 1
 echo ======================================== library tests ...
 %interpret% -s library-tests.scm
 if errorlevel 1 exit /b 1
+%compile% -specialize library-tests.scm
+if errorlevel 1 exit /b 1
+a.out
+if errorlevel 1 exit /b 1
 %interpret% -s records-and-setters-test.scm
 if errorlevel 1 exit /b 1
 %compile% records-and-setters-test.scm
diff --git a/tests/runtests.sh b/tests/runtests.sh
index bb68c14a..1ec59cd2 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -131,6 +131,8 @@ $compile test-gc-hooks.scm
 
 echo "======================================== library tests ..."
 $interpret -s library-tests.scm
+$compile -specialize library-tests.scm
+./a.out
 $interpret -s records-and-setters-test.scm
 $compile records-and-setters-test.scm
 ./a.out
diff --git a/types.db b/types.db
index 5e42fec2..465ba2bc 100644
--- a/types.db
+++ b/types.db
@@ -418,7 +418,7 @@
 (round (#(procedure #:clean #:enforce) round (number) number)
        ((fixnum) (fixnum) #(1))
        ((float) (float)
-	(##core#inline_allocate ("C_a_i_flonum_round" 4) #(1))))
+	(##core#inline_allocate ("C_a_i_flonum_round_proper" 4) #(1))))
 
 (exact->inexact (#(procedure #:clean #:enforce) exact->inexact (number) float)
 		((float) #(1))
@@ -470,9 +470,9 @@
 			       (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
       ((fixnum float)
        (##core#inline_allocate ("C_a_i_flonum_atan2" 4) 
-			       (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))
+			       (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
 			       #(2)))
-      ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1))))
+      ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1) #(2))))
 
 (number->string (#(procedure #:clean #:enforce) number->string (number #!optional number) string)
 		((fixnum) (##sys#fixnum->string #(1))))
@@ -889,7 +889,7 @@
 	 ((float) (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1) )))
 
 (fpinteger? (#(procedure #:clean #:enforce) fpinteger? (float) boolean)
-	    ((float) (##core#inline "C_u_i_flonum_intergerp" #(1) )))
+	    ((float) (##core#inline "C_u_i_fpintegerp" #(1) )))
 
 (fplog (#(procedure #:clean #:enforce) fplog (float) float)
        ((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1) )))