diff options
author | Mark H Weaver <mhw@netris.org> | 2013-07-16 03:33:02 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2013-07-16 03:55:06 -0400 |
commit | 62460767e133b4516c30920a4ba705889fb99f18 (patch) | |
tree | 7494550e39d54c490d7a57fea56a8de4d9d03887 | |
parent | 284859c2f9b7072dd0bc1215d43663bb87858025 (diff) | |
download | guile-62460767e133b4516c30920a4ba705889fb99f18.tar.gz |
Allow fl+ and fl* to accept zero arguments.
Fixes <http://bugs.gnu.org/14869>.
Reported by Göran Weinholt <goran@weinholt.se>.
* module/rnrs/arithmetic/flonums.scm (fl+, fl*): Accept zero arguments.
* test-suite/tests/r6rs-arithmetic-flonums.test (fl+, fl*): Add tests.
-rw-r--r-- | module/rnrs/arithmetic/flonums.scm | 14 | ||||
-rw-r--r-- | test-suite/tests/r6rs-arithmetic-flonums.test | 6 |
2 files changed, 10 insertions, 10 deletions
diff --git a/module/rnrs/arithmetic/flonums.scm b/module/rnrs/arithmetic/flonums.scm index b65c294b5..558b0afd0 100644 --- a/module/rnrs/arithmetic/flonums.scm +++ b/module/rnrs/arithmetic/flonums.scm @@ -103,15 +103,13 @@ (apply assert-flonum flargs) (apply min flargs))) - (define (fl+ fl1 . args) - (let ((flargs (cons fl1 args))) - (apply assert-flonum flargs) - (apply + flargs))) + (define (fl+ . args) + (apply assert-flonum args) + (if (null? args) 0.0 (apply + args))) - (define (fl* fl1 . args) - (let ((flargs (cons fl1 args))) - (apply assert-flonum flargs) - (apply * flargs))) + (define (fl* . args) + (apply assert-flonum args) + (if (null? args) 1.0 (apply * args))) (define (fl- fl1 . args) (let ((flargs (cons fl1 args))) diff --git a/test-suite/tests/r6rs-arithmetic-flonums.test b/test-suite/tests/r6rs-arithmetic-flonums.test index af9dbbf45..4222e8d8b 100644 --- a/test-suite/tests/r6rs-arithmetic-flonums.test +++ b/test-suite/tests/r6rs-arithmetic-flonums.test @@ -162,10 +162,12 @@ (pass-if "simple" (fl=? (flmin -1.0 0.0 2.0) -1.0))) (with-test-prefix "fl+" - (pass-if "simple" (fl=? (fl+ 2.141 1.0 0.1) 3.241))) + (pass-if "simple" (fl=? (fl+ 2.141 1.0 0.1) 3.241)) + (pass-if "zero args" (fl=? (fl+) 0.0))) (with-test-prefix "fl*" - (pass-if "simple" (fl=? (fl* 1.0 2.0 3.0 1.5) 9.0))) + (pass-if "simple" (fl=? (fl* 1.0 2.0 3.0 1.5) 9.0)) + (pass-if "zero args" (fl=? (fl*) 1.0))) (with-test-prefix "fl-" (pass-if "unary fl- negates argument" (fl=? (fl- 2.0) -2.0)) |