[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-31-gad922d
From: |
Mark H Weaver |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-31-gad922d0 |
Date: |
Tue, 16 Jul 2013 08:52:46 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=ad922d065c5f8b01c4ace3ee34d26300409e44fa
The branch, stable-2.0 has been updated
via ad922d065c5f8b01c4ace3ee34d26300409e44fa (commit)
from 85b32d43e63bd2939ce3706f44a50f153ba01a46 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit ad922d065c5f8b01c4ace3ee34d26300409e44fa
Author: Mark H Weaver <address@hidden>
Date: Tue Jul 16 04:43:07 2013 -0400
Flonum operations always return flonums.
Fixes <http://bugs.gnu.org/14871>.
Reported by Göran Weinholt <address@hidden>.
* module/rnrs/arithmetic/flonums.scm (ensure-flonum): New procedure.
(fllog): Rewrite using case-lambda. Handle negative zeroes. Use
'ensure-flonum'.
(flatan): Rewrite using case-lambda.
(flasin, flacos, flsqrt, flexpt): Use 'ensure-flonum'.
* test-suite/tests/r6rs-arithmetic-flonums.test
(fllog, flasin, flacos, flsqrt, flexpt): Add tests.
-----------------------------------------------------------------------
Summary of changes:
module/rnrs/arithmetic/flonums.scm | 39 ++++++++++++++++--------
test-suite/tests/r6rs-arithmetic-flonums.test | 27 ++++++++++++-----
2 files changed, 45 insertions(+), 21 deletions(-)
diff --git a/module/rnrs/arithmetic/flonums.scm
b/module/rnrs/arithmetic/flonums.scm
index be59295..fd04a4a 100644
--- a/module/rnrs/arithmetic/flonums.scm
+++ b/module/rnrs/arithmetic/flonums.scm
@@ -61,6 +61,7 @@
(only (guile) inf?)
(rnrs arithmetic fixnums (6))
(rnrs base (6))
+ (rnrs control (6))
(rnrs conditions (6))
(rnrs exceptions (6))
(rnrs lists (6))
@@ -73,6 +74,11 @@
(or (for-all (lambda (i) (and (flonum? i) (integer? i))) args)
(raise (make-assertion-violation))))
+ (define (ensure-flonum z)
+ (cond ((real? z) z)
+ ((zero? (imag-part z)) (real-part z))
+ (else +nan.0)))
+
(define (real->flonum x)
(or (real? x) (raise (make-assertion-violation)))
(exact->inexact x))
@@ -167,23 +173,30 @@
(define (flround fl) (assert-flonum fl) (round fl))
(define (flexp fl) (assert-flonum fl) (exp fl))
- (define* (fllog fl #:optional fl2)
- (assert-flonum fl)
- (cond ((fl=? fl -inf.0) +nan.0)
- (fl2 (begin (assert-flonum fl2) (/ (log fl) (log fl2))))
- (else (log fl))))
+ (define fllog
+ (case-lambda
+ ((fl)
+ (assert-flonum fl)
+ ;; add 0.0 to fl, to change -0.0 to 0.0,
+ ;; so that (fllog -0.0) will be -inf.0, not -inf.0+pi*i.
+ (ensure-flonum (log (+ fl 0.0))))
+ ((fl fl2)
+ (assert-flonum fl fl2)
+ (ensure-flonum (/ (log (+ fl 0.0))
+ (log (+ fl2 0.0)))))))
(define (flsin fl) (assert-flonum fl) (sin fl))
(define (flcos fl) (assert-flonum fl) (cos fl))
(define (fltan fl) (assert-flonum fl) (tan fl))
- (define (flasin fl) (assert-flonum fl) (asin fl))
- (define (flacos fl) (assert-flonum fl) (acos fl))
- (define* (flatan fl #:optional fl2)
- (assert-flonum fl)
- (if fl2 (begin (assert-flonum fl2) (atan fl fl2)) (atan fl)))
-
- (define (flsqrt fl) (assert-flonum fl) (sqrt fl))
- (define (flexpt fl1 fl2) (assert-flonum fl1 fl2) (expt fl1 fl2))
+ (define (flasin fl) (assert-flonum fl) (ensure-flonum (asin fl)))
+ (define (flacos fl) (assert-flonum fl) (ensure-flonum (acos fl)))
+ (define flatan
+ (case-lambda
+ ((fl) (assert-flonum fl) (atan fl))
+ ((fl fl2) (assert-flonum fl fl2) (atan fl fl2))))
+
+ (define (flsqrt fl) (assert-flonum fl) (ensure-flonum (sqrt fl)))
+ (define (flexpt fl1 fl2) (assert-flonum fl1 fl2) (ensure-flonum (expt fl1
fl2)))
(define-condition-type &no-infinities
&implementation-restriction
diff --git a/test-suite/tests/r6rs-arithmetic-flonums.test
b/test-suite/tests/r6rs-arithmetic-flonums.test
index 0be504f..3df00b2 100644
--- a/test-suite/tests/r6rs-arithmetic-flonums.test
+++ b/test-suite/tests/r6rs-arithmetic-flonums.test
@@ -256,14 +256,18 @@
(with-test-prefix "fllog"
(pass-if "unary fllog returns natural log"
- (let ((l (fllog 2.718281828459045)))
- (and (fl<=? 0.9 l) (fl>=? 1.1 l))))
+ (reasonably-close? (fllog 2.718281828459045) 1.0))
(pass-if "infinities"
(and (fl=? (fllog +inf.0) +inf.0)
(flnan? (fllog -inf.0))))
- (pass-if "zeroes" (fl=? (fllog 0.0) -inf.0))
+ (pass-if "negative argument"
+ (flnan? (fllog -1.0)))
+
+ (pass-if "zero" (fl=? (fllog 0.0) -inf.0))
+ (pass-if "negative zero" (fl=? (fllog -0.0) -inf.0))
+ (pass-if "negative zero with base" (fl=? (fllog -0.0 0.5) +inf.0))
(pass-if "binary fllog returns log in specified base"
(fl=? (fllog 8.0 2.0) 3.0)))
@@ -285,12 +289,16 @@
(with-test-prefix "flasin"
(pass-if "simple"
(and (reasonably-close? (flasin 1.0) (/ fake-pi 2))
- (reasonably-close? (flasin 0.5) (/ fake-pi 6)))))
+ (reasonably-close? (flasin 0.5) (/ fake-pi 6))))
+ (pass-if "out of range"
+ (flnan? (flasin 2.0))))
(with-test-prefix "flacos"
(pass-if "simple"
(and (fl=? (flacos 1.0) 0.0)
- (reasonably-close? (flacos 0.5) (/ fake-pi 3)))))
+ (reasonably-close? (flacos 0.5) (/ fake-pi 3))))
+ (pass-if "out of range"
+ (flnan? (flacos 2.0))))
(with-test-prefix "flatan"
(pass-if "unary flatan"
@@ -306,12 +314,15 @@
(with-test-prefix "flsqrt"
(pass-if "simple" (fl=? (flsqrt 4.0) 2.0))
-
+ (pass-if "negative" (flnan? (flsqrt -1.0)))
(pass-if "infinity" (fl=? (flsqrt +inf.0) +inf.0))
-
(pass-if "negative zero" (fl=? (flsqrt -0.0) -0.0)))
-(with-test-prefix "flexpt" (pass-if "simple" (fl=? (flexpt 2.0 3.0) 8.0)))
+(with-test-prefix "flexpt"
+ (pass-if "simple" (fl=? (flexpt 2.0 3.0) 8.0))
+ (pass-if "negative squared" (fl=? (flexpt -2.0 2.0) 4.0))
+ (pass-if "negative cubed" (fl=? (flexpt -2.0 3.0) -8.0))
+ (pass-if "negative to non-integer power" (flnan? (flexpt -2.0 2.5))))
(with-test-prefix "fixnum->flonum"
(pass-if "simple" (fl=? (fixnum->flonum 100) 100.0)))
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-31-gad922d0,
Mark H Weaver <=