mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Allow fl+ and fl* to accept zero arguments.

Browse source 
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.
This commit is contained in:
Mark H Weaver 2013-07-16 03:33:02 -04:00
parent 284859c2f9
commit 62460767e1
2 changed files with 10 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/rnrs/arithmetic/flonums.scm
View file

@ -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)))

6
test-suite/tests/r6rs-arithmetic-flonums.test
View file

@ -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))