From f27c9330a5c241236f5dd9484b0bface37d3fab4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 17 Jan 2019 19:06:21 -0700 Subject: [PATCH] magnitude: return +inf.0 for a complex with [+-]inf.0 ... even if the oyther component is +nan.0. This change makes `magnitude` consistent with the hypot() C-library function. --- .../scribblings/reference/numbers.scrbl | 10 +++++-- .../racket-test-core/tests/racket/number.rktl | 30 +++++++++++++------ .../tests/racket/testing.rktl | 6 ++-- racket/src/racket/src/number.c | 19 ++++++------ 4 files changed, 43 insertions(+), 22 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/numbers.scrbl b/pkgs/racket-doc/scribblings/reference/numbers.scrbl index da57ae4ced..286e275ce9 100644 --- a/pkgs/racket-doc/scribblings/reference/numbers.scrbl +++ b/pkgs/racket-doc/scribblings/reference/numbers.scrbl @@ -761,9 +761,15 @@ Returns the imaginary part of the complex number @racket[z] in @defproc[(magnitude [z number?]) (and/c real? (not/c negative?))]{ Returns the magnitude of the complex number @racket[z] in polar - coordinates. + coordinates. A complex number with @racket[+inf.0] or @racket[-inf.0] + as a component has magnitude @racket[+inf.0], even if the other + component is @racket[+nan.0]. -@mz-examples[(magnitude -3) (magnitude 3.0) (magnitude 3+4i)]} +@mz-examples[(magnitude -3) (magnitude 3.0) (magnitude 3+4i)] + +@history[#:changed "7.2.0.2" @elem{Changed to always return @racket[+inf.0] + for a complex number with a @racket[+inf.0] + or @racket[-inf.0] component.}]} @defproc[(angle [z number?]) real?]{ Returns the angle of diff --git a/pkgs/racket-test-core/tests/racket/number.rktl b/pkgs/racket-test-core/tests/racket/number.rktl index 79d61e9bdc..a912be2fa7 100644 --- a/pkgs/racket-test-core/tests/racket/number.rktl +++ b/pkgs/racket-test-core/tests/racket/number.rktl @@ -6,6 +6,7 @@ (require racket/extflonum racket/random racket/list) (define has-single-flonum? (not (eq? 'chez-scheme (system-type 'vm)))) +(define has-exact-zero-inexact-complex? (not (eq? 'chez-scheme (system-type 'vm)))) (test #f number? 'a) (test #f complex? 'a) @@ -1593,22 +1594,27 @@ (test -inf.0 imag-part (make-rectangular +inf.0 -inf.0)) (test (make-rectangular +inf.0 -inf.0) * 1. (make-rectangular +inf.0 -inf.0)) -(test (make-rectangular +inf.0 +inf.0) * +1.0i (make-rectangular +inf.0 -inf.0)) +(when has-exact-zero-inexact-complex? + (test (make-rectangular +inf.0 +inf.0) * +1.0i (make-rectangular +inf.0 -inf.0))) (test (make-rectangular -inf.0 +inf.0) * -3. (make-rectangular +inf.0 -inf.0)) (test (make-rectangular +inf.0 -inf.0) * (make-rectangular +inf.0 -inf.0) 1.) -(test (make-rectangular +inf.0 +inf.0) * (make-rectangular +inf.0 -inf.0) +1.0i) +(when has-exact-zero-inexact-complex? + (test (make-rectangular +inf.0 +inf.0) * (make-rectangular +inf.0 -inf.0) +1.0i)) (test (make-rectangular -inf.0 +inf.0) * (make-rectangular +inf.0 -inf.0) -3.) (test (make-rectangular +inf.0 -inf.0) / (make-rectangular +inf.0 -inf.0) 1.) -(test (make-rectangular -inf.0 -inf.0) / (make-rectangular +inf.0 -inf.0) +1.0i) +(when has-exact-zero-inexact-complex? + (test (make-rectangular -inf.0 -inf.0) / (make-rectangular +inf.0 -inf.0) +1.0i)) (test (make-rectangular -inf.0 +inf.0) / (make-rectangular +inf.0 -inf.0) -3.) ;; Test division with exact zeros in demoniator where ;; the exact zero gets polluted to an inexact zero unless ;; it's special-cased -(test 0-0.0i / 0+1.0i -inf.0) +(when has-exact-zero-inexact-complex? + (test 0-0.0i / 0+1.0i -inf.0)) (test -0.0-0.0i / 1.0+1.0i -inf.0) -(test -0.0 / 0+1.0i 0-inf.0i) -(test -0.0+0.0i / 1.0+1.0i 0-inf.0i) +(when has-exact-zero-inexact-complex? + (test -0.0 / 0+1.0i 0-inf.0i) + (test -0.0+0.0i / 1.0+1.0i 0-inf.0i)) (test-i-nan.0 * 1.+0.i (make-rectangular +inf.0 -inf.0)) (test-i-nan.0 * 0.+1.0i (make-rectangular +inf.0 -inf.0)) @@ -1640,8 +1646,11 @@ (test +inf.0 magnitude +inf.0+1i) (test +inf.0 magnitude +inf.0+0.0i) (test +inf.0 magnitude 0.0+inf.0i) -(test +nan.0 magnitude +nan.0+inf.0i) -(test +nan.0 magnitude +inf.0+nan.0i) +(test +inf.0 magnitude +nan.0+inf.0i) +(test +inf.0 magnitude +inf.0+nan.0i) +(test +nan.0 magnitude +nan.0+2.0i) +(test +nan.0 magnitude +2.0+nan.0i) +(test +nan.0 magnitude 0+nan.0i) (test +inf.f magnitude 3.0f0-inf.fi) (test +nan.f magnitude 3.0f0+nan.fi) (test 3.0f0 magnitude 3.0f0+0.0f0i) @@ -1802,7 +1811,10 @@ (test '(0+97184015999i -45402459391) call-with-values (lambda () (integer-sqrt/remainder (expt -2 73))) list) (test '(2.0 1.0) call-with-values (lambda () (integer-sqrt/remainder 5.0)) list) -(test '(0+2.0i -1.0) call-with-values (lambda () (integer-sqrt/remainder -5.0)) list) +(test (if has-exact-zero-inexact-complex? + '(0+2.0i -1.0) + '(0+2.0i -1.0-0.0i)) + call-with-values (lambda () (integer-sqrt/remainder -5.0)) list) (err/rt-test (integer-sqrt/remainder 5.0+0.0i)) (err/rt-test (integer-sqrt/remainder -5.0+0.0i)) diff --git a/pkgs/racket-test-core/tests/racket/testing.rktl b/pkgs/racket-test-core/tests/racket/testing.rktl index 6e88f152cf..90dc98c58e 100644 --- a/pkgs/racket-test-core/tests/racket/testing.rktl +++ b/pkgs/racket-test-core/tests/racket/testing.rktl @@ -338,8 +338,10 @@ transcript. number-of-exn-tests) (if ok? (printf "~aPassed all tests.\n" Section-prefix) - (begin (printf "~aErrors were:\n~a(Section (got expected (call)))\n" - Section-prefix Section-prefix) + (begin (printf "~aErrors were [~a]:\n~a(Section (got expected (call)))\n" + Section-prefix + (length errs) + Section-prefix) (for-each (lambda (l) (printf "~a~s\n" Section-prefix l)) (reverse errs)) (when final? (exit 1)))) diff --git a/racket/src/racket/src/number.c b/racket/src/racket/src/number.c index 9c646d67b5..2fa3297f6e 100644 --- a/racket/src/racket/src/number.c +++ b/racket/src/racket/src/number.c @@ -3886,13 +3886,13 @@ static Scheme_Object *magnitude(int argc, Scheme_Object *argv[]) if (SCHEME_FLTP(i)) { float f; f = SCHEME_FLT_VAL(i); - if (MZ_IS_POS_INFINITY((double) f)) { + if (MZ_IS_INFINITY((double) f)) + return scheme_single_inf_object; + else if (MZ_IS_NAN((double) f)) { if (SCHEME_FLTP(r)) { /* `r` is either a single-precision float or exact 0 */ f = SCHEME_FLT_VAL(r); - if (MZ_IS_NAN((double) f)) { - return scheme_single_nan_object; - } - return scheme_single_inf_object; + if (MZ_IS_INFINITY((double) f)) + return scheme_single_inf_object; } } } @@ -3900,13 +3900,14 @@ static Scheme_Object *magnitude(int argc, Scheme_Object *argv[]) if (SCHEME_FLOATP(i)) { double d; d = SCHEME_FLOAT_VAL(i); - if (MZ_IS_POS_INFINITY(d)) { + if (MZ_IS_INFINITY(d)) + return scheme_inf_object; + else if (MZ_IS_NAN(d)) { if (SCHEME_FLOATP(r)) { d = SCHEME_FLOAT_VAL(r); - if (MZ_IS_NAN(d)) - return scheme_nan_object; + if (MZ_IS_INFINITY(d)) + return scheme_inf_object; } - return scheme_inf_object; } } q = scheme_bin_div(r, i);