mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity
guile/test-suite/tests/r6rs-arithmetic-flonums.test
Mark H Weaver ff62c16828 Add two new sets of fast quotient and remainder operators 
* libguile/numbers.c (scm_euclidean_quo_and_rem, scm_euclidean_quotient,
  scm_euclidean_remainder, scm_centered_quo_and_rem,
  scm_centered_quotient, scm_centered_remainder): New extensible
  procedures `euclidean/', `euclidean-quotient', `euclidean-remainder',
  `centered/', `centered-quotient', `centered-remainder'.

* libguile/numbers.h: Add function prototypes.

* module/rnrs/base.scm: Remove incorrect stub implementations of `div',
  `mod', `div-and-mod', `div0', `mod0', and `div0-and-mod0'.  Instead do
  renaming imports of `euclidean-quotient', `euclidean-remainder',
  `euclidean/', `centered-quotient', `centered-remainder', and
  `centered/', which are equivalent to the R6RS operators.

* module/rnrs/arithmetic/fixnums.scm (fxdiv, fxmod, fxdiv-and-mod,
  fxdiv0, fxmod0, fxdiv0-and-mod0): Remove redundant checks for division
  by zero and unnecessary complexity.
  (fx+/carry): Remove unneeded calls to `inexact->exact'.

* module/rnrs/arithmetic/flonums.scm (fldiv, flmod, fldiv-and-mod,
  fldiv0, flmod0, fldiv0-and-mod0): Remove redundant checks for division
  by zero and unnecessary complexity.  Remove unneeded calls to
  `inexact->exact' and `exact->inexact'

* test-suite/tests/numbers.test: (test-eqv?): New internal predicate for
  comparing numerical outputs with expected values.

  Add extensive test code for `euclidean/', `euclidean-quotient',
  `euclidean-remainder', `centered/', `centered-quotient',
  `centered-remainder'.

* test-suite/tests/r6rs-arithmetic-fixnums.test: Fix some broken test
  cases, and remove `unresolved' test markers for `fxdiv', `fxmod',
  `fxdiv-and-mod', `fxdiv0', `fxmod0', and `fxdiv0-and-mod0'.

* test-suite/tests/r6rs-arithmetic-flonums.test: Remove `unresolved'
  test markers for `fldiv', `flmod', `fldiv-and-mod', `fldiv0',
  `flmod0', and `fldiv0-and-mod0'.

* doc/ref/api-data.texi (Arithmetic): Document `euclidean/',
  `euclidean-quotient', `euclidean-remainder', `centered/',
  `centered-quotient', and `centered-remainder'.

  (Operations on Integer Values): Add cross-references to `euclidean/'
  et al, from `quotient', `remainder', and `modulo'.

* doc/ref/r6rs.texi (rnrs base): Improve documentation for `div', `mod',
  `div-and-mod', `div0', `mod0', and `div0-and-mod0'.  Add
  cross-references to `euclidean/' et al.

* NEWS: Add NEWS entry.
2011-01-30 23:00:38 +01:00

309 lines
8.9 KiB
Text
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; arithmetic-flonums.test --- Test suite for R6RS (rnrs arithmetic flonums)
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-r6rs-arithmetic-flonums)
:use-module ((rnrs arithmetic flonums) :version (6))
:use-module ((rnrs conditions) :version (6))
:use-module ((rnrs exceptions) :version (6))
:use-module (test-suite lib))
(define fake-pi 3.14159265)
(define (reasonably-close? x y) (< (abs (- x y)) 0.0000001))
(with-test-prefix "flonum?"
(pass-if "flonum? is #t on flonum"
(flonum? 1.5))
(pass-if "flonum? is #f on non-flonum"
(not (flonum? 3))))
(with-test-prefix "real->flonum"
(pass-if "simple"
(flonum? (real->flonum 3))))
(with-test-prefix "fl=?"
(pass-if "fl=? is #t for eqv inputs"
(fl=? 3.0 3.0 3.0))
(pass-if "fl=? is #f for non-eqv inputs"
(not (fl=? 1.5 0.0 3.0)))
(pass-if "+inf.0 is fl= to itself"
(fl=? +inf.0 +inf.0))
(pass-if "0.0 and -0.0 are fl="
(fl=? 0.0 -0.0)))
(with-test-prefix "fl<?"
(pass-if "fl<? is #t for monotonically < inputs"
(fl<? 1.0 2.0 3.0))
(pass-if "fl<? is #f for non-monotonically < inputs"
(not (fl<? 2.0 2.0 1.4))))
(with-test-prefix "fl<=?"
(pass-if "fl<=? is #t for monotonically < or = inputs"
(fl<=? 1.0 1.2 1.2))
(pass-if "fl<=? is #f non-monotonically < or = inputs"
(not (fl<=? 2.0 1.0 0.9))))
(with-test-prefix "fl>?"
(pass-if "fl>? is #t for monotonically > inputs"
(fl>? 3.0 2.0 1.0))
(pass-if "fl>? is #f for non-monotonically > inputs"
(not (fl>? 1.0 1.0 1.2))))
(with-test-prefix "fl>=?"
(pass-if "fl>=? is #t for monotonically > or = inputs"
(fl>=? 3.0 2.0 2.0))
(pass-if "fl>=? is #f for non-monotonically > or = inputs"
(not (fl>=? 1.0 1.2 1.2))))
(with-test-prefix "flinteger?"
(pass-if "flinteger? is #t on integer flomnums"
(flinteger? 1.0))
(pass-if "flinteger? is #f on non-integer flonums"
(not (flinteger? 1.5))))
(with-test-prefix "flzero?"
(pass-if "flzero? is #t for 0.0 and -0.0"
(and (flzero? 0.0) (flzero? -0.0)))
(pass-if "flzero? is #f for non-zero flonums"
(not (flzero? 1.0))))
(with-test-prefix "flpositive?"
(pass-if "flpositive? is #t on positive flonum"
(flpositive? 1.0))
(pass-if "flpositive? is #f on negative flonum"
(not (flpositive? -1.0)))
(pass-if "0.0 and -0.0 are not flpositive"
(and (not (flpositive? 0.0)) (not (flpositive? -0.0)))))
(with-test-prefix "flnegative?"
(pass-if "flnegative? is #t on negative flonum"
(flnegative? -1.0))
(pass-if "flnegative? is #f on positive flonum"
(not (flnegative? 1.0)))
(pass-if "0.0 and -0.0 are not flnegative"
(and (not (flnegative? 0.0)) (not (flnegative? -0.0)))))
(with-test-prefix "flodd?"
(pass-if "&assertion raised on non-integer flonum"
(guard (condition ((assertion-violation? condition) #t) (else #f))
(begin (flodd? 1.5) #f)))
(pass-if "flodd? is #t on odd flonums"
(flodd? 3.0))
(pass-if "flodd? is #f on even flonums"
(not (flodd? 2.0))))
(with-test-prefix "fleven?"
(pass-if "&assertion raised on non-integer flonum"
(guard (condition ((assertion-violation? condition) #t) (else #f))
(begin (fleven? 1.5) #f)))
(pass-if "fleven? is #t on even flonums"
(fleven? 2.0))
(pass-if "fleven? is #f on odd flonums"
(not (fleven? 3.0))))
(with-test-prefix "flfinite?"
(pass-if "flfinite? is #t on non-infinite flonums"
(flfinite? 2.0))
(pass-if "flfinite? is #f on infinities"
(and (not (flfinite? +inf.0)) (not (flfinite? -inf.0)))))
(with-test-prefix "flinfinite?"
(pass-if "flinfinite? is #t on infinities"
(and (flinfinite? +inf.0) (flinfinite? -inf.0)))
(pass-if "flinfinite? is #f on non-infinite flonums"
(not (flinfinite? 2.0))))
(with-test-prefix "flnan?"
(pass-if "flnan? is #t on NaN and -NaN"
(and (flnan? +nan.0) (flnan? -nan.0)))
(pass-if "flnan? is #f on non-NaN values"
(not (flnan? 1.5))))
(with-test-prefix "flmax"
(pass-if "simple" (fl=? (flmax 1.0 3.0 2.0) 3.0)))
(with-test-prefix "flmin"
(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)))
(with-test-prefix "fl*"
(pass-if "simple" (fl=? (fl* 1.0 2.0 3.0 1.5) 9.0)))
(with-test-prefix "fl-"
(pass-if "unary fl- negates argument" (fl=? (fl- 2.0) -2.0))
(pass-if "simple" (fl=? (fl- 10.5 6.0 0.5) 4.0)))
(with-test-prefix "fl/"
(pass-if "unary fl/ returns multiplicative inverse" (fl=? (fl/ 10.0) 0.1))
(pass-if "simple" (fl=? (fl/ 10.0 2.0 2.0) 2.5)))
(with-test-prefix "flabs"
(pass-if "simple" (and (fl=? (flabs -1.0) 1.0) (fl=? (flabs 1.23) 1.23))))
(with-test-prefix "fldiv-and-mod"
(pass-if "simple"
(call-with-values (lambda () (fldiv-and-mod 5.0 2.0))
(lambda (div mod) (fl=? div 2.0) (fl=? mod 1.0)))))
(with-test-prefix "fldiv"
(pass-if "simple" (fl=? (fldiv 5.0 2.0) 2.0)))
(with-test-prefix "flmod"
(pass-if "simple" (fl=? (flmod 5.0 2.0) 1.0)))
(with-test-prefix "fldiv0-and-mod0"
(pass-if "simple"
(call-with-values (lambda () (fldiv0-and-mod0 -123.0 10.0))
(lambda (div mod)
(and (fl=? div -12.0) (fl=? mod -3.0))))))
(with-test-prefix "fldiv0"
(pass-if "simple" (fl=? (fldiv0 -123.0 10.0) -12.0)))
(with-test-prefix "flmod0"
(pass-if "simple" (fl=? (flmod0 -123.0 10.0) -3.0)))
(with-test-prefix "flnumerator"
(pass-if "simple" (fl=? (flnumerator 0.5) 1.0))
(pass-if "infinities"
(and (fl=? (flnumerator +inf.0) +inf.0)
(fl=? (flnumerator -inf.0) -inf.0)))
(pass-if "negative zero" (fl=? (flnumerator -0.0) -0.0)))
(with-test-prefix "fldenominator"
(pass-if "simple" (fl=? (fldenominator 0.5) 2.0))
(pass-if "infinities"
(and (fl=? (fldenominator +inf.0) 1.0)
(fl=? (fldenominator -inf.0) 1.0)))
(pass-if "zero" (fl=? (fldenominator 0.0) 1.0)))
(with-test-prefix "flfloor"
(pass-if "simple"
(and (fl=? (flfloor -4.3) -5.0)
(fl=? (flfloor 3.5) 3.0))))
(with-test-prefix "flceiling"
(pass-if "simple"
(and (fl=? (flceiling -4.3) -4.0)
(fl=? (flceiling 3.5) 4.0))))
(with-test-prefix "fltruncate"
(pass-if "simple"
(and (fl=? (fltruncate -4.3) -4.0)
(fl=? (fltruncate 3.5) 3.0))))
(with-test-prefix "flround"
(pass-if "simple"
(and (fl=? (flround -4.3) -4.0)
(fl=? (flround 3.5) 4.0))))
(with-test-prefix "flexp"
(pass-if "infinities"
(and (fl=? (flexp +inf.0) +inf.0)
(fl=? (flexp -inf.0) 0.0))))
(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))))
(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 "binary fllog returns log in specified base"
(fl=? (fllog 8.0 2.0) 3.0)))
(with-test-prefix "flsin"
(pass-if "simple"
(and (reasonably-close? (flsin (/ fake-pi 2)) 1.0)
(reasonably-close? (flsin (/ fake-pi 6)) 0.5))))
(with-test-prefix "flcos"
(pass-if "simple"
(and (fl=? (flcos 0.0) 1.0) (reasonably-close? (flcos (/ fake-pi 3)) 0.5))))
(with-test-prefix "fltan"
(pass-if "simple"
(and (reasonably-close? (fltan (/ fake-pi 4)) 1.0)
(reasonably-close? (fltan (/ (* 3 fake-pi) 4)) -1.0))))
(with-test-prefix "flasin"
(pass-if "simple"
(and (reasonably-close? (flasin 1.0) (/ fake-pi 2))
(reasonably-close? (flasin 0.5) (/ fake-pi 6)))))
(with-test-prefix "flacos"
(pass-if "simple"
(and (fl=? (flacos 1.0) 0.0)
(reasonably-close? (flacos 0.5) (/ fake-pi 3)))))
(with-test-prefix "flatan"
(pass-if "unary flatan"
(and (reasonably-close? (flatan 1.0) (/ fake-pi 4))
(reasonably-close? (flatan -1.0) (/ fake-pi -4))))
(pass-if "infinities"
(and (reasonably-close? (flatan -inf.0) -1.5707963267949)
(reasonably-close? (flatan +inf.0) 1.5707963267949)))
(pass-if "binary flatan"
(and (reasonably-close? (flatan 3.5 3.5) (/ fake-pi 4)))))
(with-test-prefix "flsqrt"
(pass-if "simple" (fl=? (flsqrt 4.0) 2.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 "fixnum->flonum"
(pass-if "simple" (fl=? (fixnum->flonum 100) 100.0)))
View git blame Copy permalink