Hi there,
I found a bug in the specialization for the ROUND procedure; the
specialization calls C_a_i_flonum_round while it should call
C_a_i_flonum_round_proper. This results in a difference when the
following program is interpreted versus when it is compiled with
various levels of optimization:
(print (round 4.5)) ;; 5.0 when compiled with -O3 or higher, 4.0 otherwise
The correct answer is 4.0 since R5RS says round needs to round to the
nearest even number when the number is halfway between two integers.
I added a test for this to library-tests.scm, but figured out that
it wasn't compiled at all, which is why this bug wasn't caught by
"make check". Since the library is large and has many specializations,
it makes sense to compile the library test. As we add more tests, these
will automatically test any additional specializations.
After making it compile, I found several more mistakes which I've also
fixed in this patch.
By the way, I don't understand why the continuation test at the end
used to work; when compiled it complains the second time it calls
(k #f) that k is false, which I'd expect. Can someone explain why
this isn't the case in interpreted mode?
Cheers,
Peter
--
http://sjamaan.ath.cx
--
"The process of preparing programs for a digital computer
is especially attractive, not only because it can be economically
and scientifically rewarding, but also because it can be an aesthetic
experience much like composing poetry or music."
-- Donald Knuth
>From e6369cde312b1a03be4c23a37260f87ca7bccb15 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter....@xs4all.nl>
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
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
