>From e6369cde312b1a03be4c23a37260f87ca7bccb15 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 11 Mar 2012 20:52:01 +0100 Subject: [PATCH] Ensure library-tests are compiled to catch specialization errors more easily; fix several of those found this way --- tests/library-tests.scm | 8 ++++++-- tests/runtests.bat | 4 ++++ tests/runtests.sh | 2 ++ types.db | 8 ++++---- 4 files changed, 16 insertions(+), 6 deletions(-) diff --git a/tests/library-tests.scm b/tests/library-tests.scm index 7a491a0..49b91ca 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 88891fa..be16134 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 bb68c14..1ec59cd 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 5e42fec..465ba2b 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) ))) -- 1.7.9.1