[Guile-commits] GNU Guile branch, master, updated. v2.1.0-90-g902a4e7

[Mark H Weaver]

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=902a4e779da1193ff9097c23b40fbd44ab2df6a3

The branch, master has been updated
       via  902a4e779da1193ff9097c23b40fbd44ab2df6a3 (commit)
       via  3bbca1f7237c0e9d9419eaea8f274c9cd7314f04 (commit)
       via  b4c55c9ccedd47c16007b590f064ef3bd67565aa (commit)
       via  ad922d065c5f8b01c4ace3ee34d26300409e44fa (commit)
       via  85b32d43e63bd2939ce3706f44a50f153ba01a46 (commit)
       via  ff5568389c037f7c7b5dff9505c69e7f586f95aa (commit)
       via  62460767e133b4516c30920a4ba705889fb99f18 (commit)
      from  3c2fe0ac03c1d9a2cf0cf595fb13ce0f73f21563 (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 902a4e779da1193ff9097c23b40fbd44ab2df6a3
Merge: 3c2fe0a 3bbca1f
Author: Mark H Weaver <address@hidden>
Date:   Tue Jul 16 06:49:20 2013 -0400

    Merge remote-tracking branch 'origin/stable-2.0'
    
    Conflicts:
        libguile/numbers.c

-----------------------------------------------------------------------

Summary of changes:
 libguile/numbers.c                            |   80 ++++++++++++++++--------
 module/rnrs/arithmetic/flonums.scm            |   57 +++++++++++-------
 test-suite/tests/numbers.test                 |   78 +++++++++++++++++++++---
 test-suite/tests/r6rs-arithmetic-flonums.test |   43 ++++++++++----
 4 files changed, 186 insertions(+), 72 deletions(-)

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 9857e18..3c0d765 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -4144,6 +4144,8 @@ scm_gcd (SCM x, SCM y)
           SCM_SWAP (x, y);
           goto big_inum;
         }
+      else if (SCM_REALP (y) && scm_is_integer (y))
+        goto handle_inexacts;
       else
         return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
     }
@@ -4174,6 +4176,20 @@ scm_gcd (SCM x, SCM y)
           scm_remember_upto_here_2 (x, y);
           return scm_i_normbig (result);
         }
+      else if (SCM_REALP (y) && scm_is_integer (y))
+        goto handle_inexacts;
+      else
+        SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
+    }
+  else if (SCM_REALP (x) && scm_is_integer (x))
+    {
+      if (SCM_I_INUMP (y) || SCM_BIGP (y)
+          || (SCM_REALP (y) && scm_is_integer (y)))
+        {
+        handle_inexacts:
+          return scm_exact_to_inexact (scm_gcd (scm_inexact_to_exact (x),
+                                                scm_inexact_to_exact (y)));
+        }
       else
         return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
     }
@@ -4202,22 +4218,12 @@ SCM_PRIMITIVE_GENERIC (scm_i_lcm, "lcm", 0, 2, 1,
 SCM
 scm_lcm (SCM n1, SCM n2)
 {
-  if (SCM_UNBNDP (n2))
-    {
-      if (SCM_UNBNDP (n1))
-        return SCM_I_MAKINUM (1L);
-      n2 = SCM_I_MAKINUM (1L);
-    }
-
-  if (SCM_UNLIKELY (!(SCM_I_INUMP (n1) || SCM_BIGP (n1))))
-    return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm);
-  
-  if (SCM_UNLIKELY (!(SCM_I_INUMP (n2) || SCM_BIGP (n2))))
-    return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
+  if (SCM_UNLIKELY (SCM_UNBNDP (n2)))
+    return SCM_UNBNDP (n1) ? SCM_INUM1 : scm_abs (n1);
 
-  if (SCM_I_INUMP (n1))
+  if (SCM_LIKELY (SCM_I_INUMP (n1)))
     {
-      if (SCM_I_INUMP (n2))
+      if (SCM_LIKELY (SCM_I_INUMP (n2)))
         {
           SCM d = scm_gcd (n1, n2);
           if (scm_is_eq (d, SCM_INUM0))
@@ -4225,7 +4231,7 @@ scm_lcm (SCM n1, SCM n2)
           else
             return scm_abs (scm_product (n1, scm_quotient (n2, d)));
         }
-      else
+      else if (SCM_LIKELY (SCM_BIGP (n2)))
         {
           /* inum n1, big n2 */
         inumbig:
@@ -4239,8 +4245,12 @@ scm_lcm (SCM n1, SCM n2)
             return result;
           }
         }
+      else if (SCM_REALP (n2) && scm_is_integer (n2))
+        goto handle_inexacts;
+      else
+        return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
     }
-  else
+  else if (SCM_LIKELY (SCM_BIGP (n1)))
     {
       /* big n1 */
       if (SCM_I_INUMP (n2))
@@ -4248,7 +4258,7 @@ scm_lcm (SCM n1, SCM n2)
           SCM_SWAP (n1, n2);
           goto inumbig;
         }
-      else
+      else if (SCM_LIKELY (SCM_BIGP (n2)))
         {
           SCM result = scm_i_mkbig ();
           mpz_lcm(SCM_I_BIG_MPZ (result),
@@ -4258,7 +4268,25 @@ scm_lcm (SCM n1, SCM n2)
           /* shouldn't need to normalize b/c lcm of 2 bigs should be big */
           return result;
         }
+      else if (SCM_REALP (n2) && scm_is_integer (n2))
+        goto handle_inexacts;
+      else
+        return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
     }
+  else if (SCM_REALP (n1) && scm_is_integer (n1))
+    {
+      if (SCM_I_INUMP (n2) || SCM_BIGP (n2)
+          || (SCM_REALP (n2) && scm_is_integer (n2)))
+        {
+        handle_inexacts:
+          return scm_exact_to_inexact (scm_lcm (scm_inexact_to_exact (n1),
+                                                scm_inexact_to_exact (n2)));
+        }
+      else
+        return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
+    }
+  else
+    return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm);
 }
 
 /* Emulating 2's complement bignums with sign magnitude arithmetic:
@@ -7230,17 +7258,16 @@ scm_max (SCM x, SCM y)
          double xx = SCM_REAL_VALUE (x);
          double yy = SCM_REAL_VALUE (y);
 
-         /* For purposes of max: +inf.0 > nan > everything else, per R6RS */
+         /* For purposes of max: nan > +inf.0 > everything else,
+             per the R6RS errata */
          if (xx > yy)
            return x;
          else if (SCM_LIKELY (xx < yy))
            return y;
          /* If neither (xx > yy) nor (xx < yy), then
             either they're equal or one is a NaN */
-         else if (SCM_UNLIKELY (isnan (xx)))
-           return DOUBLE_IS_POSITIVE_INFINITY (yy) ? y : x;
-         else if (SCM_UNLIKELY (isnan (yy)))
-           return DOUBLE_IS_POSITIVE_INFINITY (xx) ? x : y;
+         else if (SCM_UNLIKELY (xx != yy))
+           return (xx != xx) ? x : y;  /* Return the NaN */
          /* xx == yy, but handle signed zeroes properly */
          else if (double_is_non_negative_zero (yy))
            return y;
@@ -7390,17 +7417,16 @@ scm_min (SCM x, SCM y)
          double xx = SCM_REAL_VALUE (x);
          double yy = SCM_REAL_VALUE (y);
 
-         /* For purposes of min: -inf.0 < nan < everything else, per R6RS */
+         /* For purposes of min: nan < -inf.0 < everything else,
+             per the R6RS errata */
          if (xx < yy)
            return x;
          else if (SCM_LIKELY (xx > yy))
            return y;
          /* If neither (xx < yy) nor (xx > yy), then
             either they're equal or one is a NaN */
-         else if (SCM_UNLIKELY (isnan (xx)))
-           return DOUBLE_IS_NEGATIVE_INFINITY (yy) ? y : x;
-         else if (SCM_UNLIKELY (isnan (yy)))
-           return DOUBLE_IS_NEGATIVE_INFINITY (xx) ? x : y;
+         else if (SCM_UNLIKELY (xx != yy))
+           return (xx != xx) ? x : y;  /* Return the NaN */
          /* xx == yy, but handle signed zeroes properly */
          else if (double_is_non_negative_zero (xx))
            return y;
diff --git a/module/rnrs/arithmetic/flonums.scm 
b/module/rnrs/arithmetic/flonums.scm
index b65c294..fd04a4a 100644
--- a/module/rnrs/arithmetic/flonums.scm
+++ b/module/rnrs/arithmetic/flonums.scm
@@ -61,18 +61,24 @@
          (only (guile) inf?)
          (rnrs arithmetic fixnums (6))
          (rnrs base (6))
+         (rnrs control (6))
          (rnrs conditions (6))
          (rnrs exceptions (6))
          (rnrs lists (6))
          (rnrs r5rs (6)))
 
-  (define (flonum? obj) (and (number? obj) (inexact? obj)))
+  (define (flonum? obj) (and (real? obj) (inexact? obj)))
   (define (assert-flonum . args)
     (or (for-all flonum? args) (raise (make-assertion-violation))))
   (define (assert-iflonum . args)
     (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))
@@ -89,7 +95,7 @@
   (define (flnegative? fl) (assert-flonum fl) (negative? fl))
   (define (flodd? ifl) (assert-iflonum ifl) (odd? ifl))
   (define (fleven? ifl) (assert-iflonum ifl) (even? ifl))
-  (define (flfinite? fl) (assert-flonum fl) (not (inf? fl)))
+  (define (flfinite? fl) (assert-flonum fl) (not (or (inf? fl) (nan? fl))))
   (define (flinfinite? fl) (assert-flonum fl) (inf? fl))
   (define (flnan? fl) (assert-flonum fl) (nan? fl))
 
@@ -103,15 +109,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)))
@@ -169,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/numbers.test b/test-suite/tests/numbers.test
index ab0880d..a36d493 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -1322,6 +1322,32 @@
     (pass-if "n = fixnum-min - 1"
       (eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
 
+  (with-test-prefix "flonum arguments"
+
+    (pass-if-equal "flonum"
+        15.0
+      (gcd -15.0))
+
+    (pass-if-equal "flonum/flonum"
+        3.0
+      (gcd 6.0 -15.0))
+
+    (pass-if-equal "flonum/fixnum"
+        3.0
+      (gcd 6.0 -15))
+
+    (pass-if-equal "fixnum/flonum"
+        3.0
+      (gcd -6 15.0))
+
+    (pass-if-equal "flonum/bignum"
+        2.0
+      (gcd -6.0 (expt 2 fixnum-bit)))
+
+    (pass-if-equal "bignum/flonum"
+        3.0
+      (gcd (- (expt 3 fixnum-bit)) 6.0)))
+
   ;; Are wrong type arguments detected correctly?
 
   )
@@ -1334,8 +1360,40 @@
   ;; FIXME: more tests?
   ;; (some of these are already in r4rs.test)
   (pass-if (documented? lcm))
-  (pass-if (= (lcm) 1))
-  (pass-if (= (lcm 32 -36) 288))
+  (pass-if-equal 1 (lcm))
+  (pass-if-equal 15 (lcm -15))
+  (pass-if-equal 288 (lcm 32 -36))
+
+  (with-test-prefix "flonum arguments"
+
+    (pass-if-equal "flonum"
+        15.0
+      (lcm -15.0))
+
+    (pass-if-equal "flonum/flonum"
+        30.0
+      (lcm 6.0 -15.0))
+
+    (pass-if-equal "flonum/fixnum"
+        30.0
+      (lcm 6.0 -15))
+
+    (pass-if-equal "fixnum/flonum"
+        30.0
+      (lcm -6 15.0))
+
+    (pass-if "flonum/bignum"
+      (let ((want (* 3.0 (expt 2 fixnum-bit)))
+            (got (lcm -6.0 (expt 2 fixnum-bit))))
+        (and (inexact? got)
+             (test-eqv? 1.0 (/ want got)))))
+
+    (pass-if "bignum/flonum"
+      (let ((want (* 2.0 (expt 3 fixnum-bit)))
+            (got (lcm (- (expt 3 fixnum-bit)) 6.0)))
+        (and (inexact? got)
+             (test-eqv? 1.0 (/ want got))))))
+
   (let ((big-n 
115792089237316195423570985008687907853269984665640564039457584007913129639936) 
; 2 ^ 256
         (lcm-of-big-n-and-11 
1273712981610478149659280835095566986385969831322046204434033424087044426039296))
     (pass-if (= lcm-of-big-n-and-11 (lcm big-n 11)))
@@ -2690,7 +2748,7 @@
       (pass-if (eqv? 5/2 (max 5/2 2))))
 
     (with-test-prefix "infinities and NaNs"
-      ;; +inf.0 beats everything else, including NaNs
+      ;; +inf.0 beats everything except NaNs
       (pass-if (eqv?  +inf.0   (max   +inf.0    123   )))
       (pass-if (eqv?  +inf.0   (max    123     +inf.0 )))
       (pass-if (eqv?  +inf.0   (max   +inf.0   -123.3 )))
@@ -2703,11 +2761,9 @@
       (pass-if (eqv?  +inf.0   (max (- big*2)  +inf.0 )))
       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
-      (pass-if (eqv?  +inf.0   (max   +inf.0   +nan.0 )))
-      (pass-if (eqv?  +inf.0   (max   +nan.0   +inf.0 )))
       (pass-if (eqv?  +inf.0   (max   +inf.0   +inf.0 )))
 
-      ;; NaNs beat everything except +inf.0
+      ;; NaNs beat everything
       (pass-if (real-nan?      (max   +nan.0    123   )))
       (pass-if (real-nan?      (max    123     +nan.0 )))
       (pass-if (real-nan?      (max   +nan.0    123.3 )))
@@ -2721,6 +2777,8 @@
       (pass-if (real-nan?      (max   +nan.0   -inf.0 )))
       (pass-if (real-nan?      (max   -inf.0   +nan.0 )))
       (pass-if (real-nan?      (max   +nan.0   +nan.0 )))
+      (pass-if (real-nan?      (max   +inf.0   +nan.0 )))
+      (pass-if (real-nan?      (max   +nan.0   +inf.0 )))
 
       ;; -inf.0 always loses, except against itself
       (pass-if (eqv?   -inf.0  (max   -inf.0   -inf.0 )))
@@ -2868,7 +2926,7 @@
       (pass-if (eqv? 2   (min 5/2 2))))
 
     (with-test-prefix "infinities and NaNs"
-      ;; -inf.0 beats everything else, including NaNs
+      ;; -inf.0 beats everything except NaNs
       (pass-if (eqv?  -inf.0   (min   -inf.0    123   )))
       (pass-if (eqv?  -inf.0   (min    123     -inf.0 )))
       (pass-if (eqv?  -inf.0   (min   -inf.0   -123.3 )))
@@ -2881,11 +2939,9 @@
       (pass-if (eqv?  -inf.0   (min (- big*2)  -inf.0 )))
       (pass-if (eqv?  -inf.0   (min   -inf.0   +inf.0 )))
       (pass-if (eqv?  -inf.0   (min   +inf.0   -inf.0 )))
-      (pass-if (eqv?  -inf.0   (min   -inf.0   +nan.0 )))
-      (pass-if (eqv?  -inf.0   (min   +nan.0   -inf.0 )))
       (pass-if (eqv?  -inf.0   (min   -inf.0   -inf.0 )))
 
-      ;; NaNs beat everything except -inf.0
+      ;; NaNs beat everything
       (pass-if (real-nan?      (min   +nan.0    123   )))
       (pass-if (real-nan?      (min    123     +nan.0 )))
       (pass-if (real-nan?      (min   +nan.0    123.3 )))
@@ -2899,6 +2955,8 @@
       (pass-if (real-nan?      (min   +nan.0   +inf.0 )))
       (pass-if (real-nan?      (min   +inf.0   +nan.0 )))
       (pass-if (real-nan?      (min   +nan.0   +nan.0 )))
+      (pass-if (real-nan?      (min   -inf.0   +nan.0 )))
+      (pass-if (real-nan?      (min   +nan.0   -inf.0 )))
 
       ;; +inf.0 always loses, except against itself
       (pass-if (eqv?   +inf.0  (min   +inf.0   +inf.0 )))
diff --git a/test-suite/tests/r6rs-arithmetic-flonums.test 
b/test-suite/tests/r6rs-arithmetic-flonums.test
index af9dbbf..3df00b2 100644
--- a/test-suite/tests/r6rs-arithmetic-flonums.test
+++ b/test-suite/tests/r6rs-arithmetic-flonums.test
@@ -30,7 +30,10 @@
   (pass-if "flonum? is #t on flonum"
     (flonum? 1.5))
 
-  (pass-if "flonum? is #f on non-flonum"
+  (pass-if "flonum? is #f on complex"
+    (not (flonum? 1.5+0.0i)))
+
+  (pass-if "flonum? is #f on exact integer"
     (not (flonum? 3))))
 
 (with-test-prefix "real->flonum"
@@ -139,7 +142,10 @@
     (flfinite? 2.0))
 
   (pass-if "flfinite? is #f on infinities"
-    (and (not (flfinite? +inf.0)) (not (flfinite? -inf.0)))))
+    (and (not (flfinite? +inf.0)) (not (flfinite? -inf.0))))
+
+  (pass-if "flfinite? is #f on NaNs"
+    (not (flfinite? +nan.0))))
 
 (with-test-prefix "flinfinite?"
   (pass-if "flinfinite? is #t on infinities"
@@ -162,10 +168,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))
@@ -248,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)))
@@ -277,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"
@@ -298,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