From 4ddbe71e2dc21dedfdd0eb73e54faeb0e333a4aa Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 28 Oct 2009 16:04:39 +0000
Subject: [PATCH] fixed the comparison contracts so they work right wrt to
 complex numbers

svn: r16445
---
 collects/scheme/contract/private/misc.ss       | 16 ++++++++--------
 collects/scribblings/reference/contracts.scrbl | 10 +++++-----
 collects/tests/mzscheme/contract-test.ss       |  7 ++++++-
 3 files changed, 19 insertions(+), 14 deletions(-)

diff --git a/collects/scheme/contract/private/misc.ss b/collects/scheme/contract/private/misc.ss
index ce59ef2cdc..744d3a491f 100644
--- a/collects/scheme/contract/private/misc.ss
+++ b/collects/scheme/contract/private/misc.ss
@@ -506,7 +506,7 @@
     (let ([n (between/c-low ctc)]
           [m (between/c-high ctc)])
       (λ (x) 
-        (and (number? x)
+        (and (real? x)
              (<= n x m))))))
 
 (define-syntax (check-unary-between/c stx)
@@ -527,10 +527,10 @@
   (check-unary-between/c '>=/c x)
   (make-between/c x +inf.0))
 (define (check-between/c x y)
-  (unless (number? x)
-    (error 'between/c "expected a number as first argument, got ~e, other arg ~e" x y))
-  (unless (number? y)
-    (error 'between/c "expected a number as second argument, got ~e, other arg ~e" y x)))
+  (unless (real? x)
+    (error 'between/c "expected a real number as first argument, got ~e, other arg ~e" x y))
+  (unless (real? y)
+    (error 'between/c "expected a real number as second argument, got ~e, other arg ~e" y x)))
 (define (between/c x y)
   (check-between/c x y)
   (make-between/c x y))
@@ -604,7 +604,7 @@
                         (that (opt/info-that opt/info)))
             (values
              (syntax 
-              (if (and (number? val) (comparison val m)) 
+              (if (and (real? val) (comparison val m)) 
                   val
                   (raise-contract-error
                    val
@@ -673,11 +673,11 @@
 (define (</c x)
   (flat-named-contract
    `(</c ,x)
-   (λ (y) (and (number? y) (< y x)))))
+   (λ (y) (and (real? y) (< y x)))))
 (define (>/c x)
   (flat-named-contract
    `(>/c ,x)
-   (λ (y) (and (number? y) (> y x)))))
+   (λ (y) (and (real? y) (> y x)))))
 
 (define natural-number/c
   (flat-named-contract
diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl
index 8017622442..50795f7502 100644
--- a/collects/scribblings/reference/contracts.scrbl
+++ b/collects/scribblings/reference/contracts.scrbl
@@ -146,7 +146,7 @@ Accepts a flat contracts or a predicate and returns a flat contract
 that checks the inverse of the argument.}
 
 
-@defproc[(=/c [z number?]) flat-contract?]{
+@defproc[(=/c [z real?]) flat-contract?]{
 
 Returns a flat contract that requires the input to be a number and
 @scheme[=] to @scheme[z].}
@@ -158,18 +158,18 @@ Returns a flat contract that requires the input to be a number and
 @scheme[<] to @scheme[n].}
 
 
-@defproc[(>/c [n number?]) flat-contract?]{
+@defproc[(>/c [n real?]) flat-contract?]{
 Like @scheme[</c], but for @scheme[>].}
 
 
-@defproc[(<=/c [n number?]) flat-contract?]{
+@defproc[(<=/c [n real?]) flat-contract?]{
 Like @scheme[</c], but for @scheme[<=].}
 
 
-@defproc[(>=/c [n number?]) flat-contract?]{
+@defproc[(>=/c [n real?]) flat-contract?]{
 Like @scheme[</c], but for @scheme[>=].}
 
-@defproc[(between/c [n number?] [m number?])
+@defproc[(between/c [n real?] [m real?])
 flat-contract?]{ Returns a flat contract that requires the
 input to be a between @scheme[n] and @scheme[m] or equal to
 one of them.}
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index f86fe44fc9..89e6e5d1b7 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -5340,10 +5340,15 @@ so that propagation occurs.
 
   (test-flat-contract '(not/c integer?) #t 1)
   (test-flat-contract '(=/c 2) 2 3)
+  (test-flat-contract '(>/c 5) 10 5)
   (test-flat-contract '(>=/c 5) 5 0)
   (test-flat-contract '(<=/c 5) 5 10)
   (test-flat-contract '(</c 5) 0 5)
-  (test-flat-contract '(>/c 5) 10 5)
+  (test-flat-contract '(=/c 2) 2 0+1i)
+  (test-flat-contract '(>/c 5) 10 0+1i)
+  (test-flat-contract '(>=/c 5) 5 0+1i)
+  (test-flat-contract '(<=/c 5) 5 0+1i)
+  (test-flat-contract '(</c 5) 0 0+1i)
   (test-flat-contract '(integer-in 0 10) 0 11)
   (test-flat-contract '(integer-in 0 10) 10 3/2)
   (test-flat-contract '(integer-in 0 10) 1 1.0)