add check-within (#95)

* add check-within
* add tests for check-within with flvectors, extflvectors, and hash-tables
* add documentation for check-within

rackunit-doc/rackunit/scribblings/check.scrbl

@@ -1,10 +1,10 @@
 #lang scribble/doc
 @(require "base.rkt")
 
-@(require (for-label racket/match))
+@(require (for-label racket/match racket/flonum))
 
 @(define rackunit-eval (make-base-eval))
-@(interaction-eval #:eval rackunit-eval (require rackunit))
+@(interaction-eval #:eval rackunit-eval (require rackunit racket/flonum))
 @(interaction-eval #:eval rackunit-eval (error-print-context-length 0))
 
 @title{Checks}
@@ -70,7 +70,7 @@ The following check fails:
 ]
 }
 
-@defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message (or/c string? #f) #f))
+@defproc[(check-= (v1 number?) (v2 number?) (epsilon number?) (message (or/c string? #f) #f))
          void?]{
 
 Checks that @racket[v1] and @racket[v2] are numbers within
@@ -89,6 +89,29 @@ The following check fails:
 ]
 }
 
+@defproc[(check-within [v1 any] [v2 any] [epsilon number?] [message (or/c string? #f) #f])
+         void?]{
+
+Checks that @racket[v1] and @racket[v2] are @racket[equal?] to each
+other, while allowing numbers @italic{inside} of them to be different by
+at most @racket[epsilon] from one another. If @racket[(equal? v1 v2)] would
+call @racket[equal?] on sub-pieces that are numbers, then those numbers are
+considered "good enough" if they're within @racket[epsilon].
+
+For example, the following checks pass:
+
+@interaction[#:eval rackunit-eval
+  (check-within (list 6 10) (list 6.02 9.99) 0.05)
+  (check-within (flvector 3.0 4.0 5.0) (flvector 3.01 4.01 5.014) 0.02)
+  (check-within (hash 'C 20 'F 68) (hash 'C 25 'F 77) 10)
+]
+And the following checks fail:
+@interaction[#:eval rackunit-eval
+  (check-within (list 6.0e23 10.0) (list 6.02e23 9.8) 0.05)
+  (check-within (hash 'C 18 'F 64) (hash 'C 25 'F 77) 10)
+]
+}
+
 @defproc*[([(check-true (v any) (message (or/c string? #f) #f)) void?]
            [(check-false (v any) (message (or/c string? #f) #f)) void?]
            [(check-not-false (v any) (message (or/c string? #f) #f)) void?])]{
@@ -279,7 +302,7 @@ function, and the @racket[with-check-info] macro.
  A special wrapper around a string for use as a @tech{check-info} value. When
  displayed in a check failure message, @racket[value] is displayed without
  quotes. Used to print messages instead of writing values.
- 
+
  @(interaction
    #:eval rackunit-eval
    (define-check (string-info-check)
@@ -295,15 +318,15 @@ function, and the @racket[with-check-info] macro.
  @racket[check-info] value. A check info whose value is a nested info is
  displayed as an indented subsequence of infos. Nested infos can be placed
  inside nested infos, yielding greater indentation.
- 
+
  @(interaction
    #:eval rackunit-eval
    (define-check (nested-info-check)
      (define infos
        (list (make-check-info 'foo "foo") (make-check-info 'bar "bar")))
      (with-check-info (['nested (nested-info infos)]) (fail-check)))
    (nested-info-check))
- 
+
  @history[#:added "1.7"]}
 
 @defstruct*[dynamic-info ([proc (-> any/c)]) #:transparent]{

rackunit-lib/rackunit/private/check.rkt

@@ -8,6 +8,7 @@
          rackunit/log
          syntax/parse/define
          "base.rkt"
+         "equal-within.rkt"
          "check-info.rkt"
          "format.rkt"
          "location.rkt")
@@ -35,6 +36,7 @@
          check-eqv?
          check-equal?
          check-=
+         check-within
          check-not-false
          check-not-eq?
          check-not-eqv?
@@ -204,6 +206,14 @@
   [(check-not-equal? expr1 expr2) (not (equal? expr1 expr2))]
   [(fail) #f])
 
+(define-check (check-within expr1 expr2 epsilon)
+  (with-check-info*
+   (list (make-check-actual expr1)
+         (make-check-expected expr2))
+   (lambda ()
+     (unless (equal?/within expr1 expr2 epsilon)
+       (fail-check)))))
+
 (define-binary-check (check-eq? eq? expr1 expr2))
 (define-binary-check (check-eqv? eqv? expr1 expr2))
 (define-binary-check (check-equal? equal? expr1 expr2))

rackunit-lib/rackunit/private/equal-within.rkt

@@ -0,0 +1,27 @@
+#lang racket/base
+
+(provide equal?/within)
+
+(require racket/flonum racket/extflonum)
+
+;; equal?/within : Any Any Nonnegative-Real -> Boolean
+(define (equal?/within a b delta)
+  ;; equal-proc : Any Any -> Boolean
+  (define (equal-proc a b)
+    (cond
+      [(and (number? a) (number? b))
+       (<= (magnitude (- a b)) delta)]
+      [(and (extflonum? a) (extflonum? b))
+       (extfl<= (extflabs (extfl- a b)) (real->extfl delta))]
+      [(and (flvector? a) (flvector? b))
+       (and (= (flvector-length a) (flvector-length b))
+            (for/and ([a (in-flvector a)] [b (in-flvector b)])
+              (equal-proc a b)))]
+      [(and (extflvector? a) (extflvector? b))
+       (and (= (extflvector-length a) (extflvector-length b))
+            (for/and ([a (in-extflvector a)] [b (in-extflvector b)])
+              (equal-proc a b)))]
+      [else
+       (equal?/recur a b equal-proc)]))
+  (equal-proc a b))
+

rackunit-lib/rackunit/private/test.rkt

@@ -74,6 +74,7 @@
          test-eq?
          test-eqv?
          test-=
+         test-within
          test-true
          test-false
          test-not-false
@@ -104,6 +105,7 @@
          check-eqv?
          check-equal?
          check-=
+         check-within
          check-not-false
          check-not-eq?
          check-not-eqv?
@@ -156,6 +158,9 @@
 (define-shortcut (test-= expr1 expr2 epsilon)
   (check-= expr1 expr2 epsilon))
 
+(define-shortcut (test-within expr1 expr2 epsilon)
+  (check-within expr1 expr2 epsilon))
+
 (define-shortcut (test-true expr)
   (check-true expr))
 

rackunit-test/tests/rackunit/check-test.rkt

@@ -29,6 +29,8 @@
 #lang racket/base
 
 (require racket/runtime-path
+         racket/flonum
+         racket/extflonum
          srfi/1
          rackunit
          rackunit/private/check
@@ -92,6 +94,20 @@
     (check-not-false 3))
   (test-case "Simple check-= test"
     (check-= 1.0 1.0 0.0001))
+  (test-case "Simple check-within test"
+    (check-within 1.0 1.0 0.0001))
+  (test-case "Simple check-within test with structure"
+    (check-within (list (list 1.0) '() (list 2.0 3.0))
+                  (list (list 1.0) '() (list 2.0 3.0))
+                  0.001))
+  (test-case "Simple check-within test with flvectors"
+    (check-within (list (list 1.0) '() (flvector 2.0 3.0))
+                  (list (list 1.0) '() (flvector 2.0 3.0))
+                  0.001))
+  (test-case "Simple check-within test with hash-tables"
+    (check-within (hash 'a (list 3) 'b (flvector 10.0 20.0))
+                  (hash 'a (list 3) 'b (flvector 10.0 20.0))
+                  0.001))
 
   (test-case "Use of check as expression"
     (for-each check-false '(#f #f #f)))
@@ -152,6 +168,17 @@
                      check-not-false #f)
   (make-failure-test "check-= failure"
                      check-= 1.0 2.0 0.0)
+  (make-failure-test "check-within failure"
+                     check-within 1.0 2.0 0.0)
+  (make-failure-test "check-within failure with structure"
+                     check-within (list 1.0 2.0) (list 1.0 3.0) 0.0)
+  (make-failure-test "check-within failure with flvectors"
+                     check-within (flvector 1.0 2.0) (flvector 1.0 3.0) 0.0)
+  (make-failure-test "check-within failure with hash-tables"
+                     check-within
+                     (hash 'a 3.0 'b 10.0)
+                     (hash 'a 3.0 'b 98.6)
+                     0.0)
 
   (make-failure-test/stx "check-match failure pred"
                          check-match 5 x (even? x))
@@ -161,9 +188,45 @@
 
   (test-case "check-= allows differences within epsilon"
     (check-= 1.0 1.09 1.1))
+  (test-case "check-within allows differences within epsilon"
+    (check-within (list (list 1.0) '() (list 2.0 3.0))
+                  (list (list 0.9999) '() (list 2.001 3.0))
+                  0.1))
+  (test-case "check-within allows differences within epsilon inside flvectors"
+    (check-within (list (flvector 1.0) '() (flvector 2.0 3.0))
+                  (list (flvector 0.9999) '() (flvector 2.001 3.0))
+                  0.1))
+  (test-case "check-within allows differences within epsilon in extflvectors"
+    (check-within (list (extflvector 1.0t0) '() (extflvector 2.0t0 3.0t0))
+                  (list (extflvector 0.9999t0) '() (extflvector 2.001t0 3.0t0))
+                  0.1))
+  (test-case "check-within allows differences within eplison inside hash-tables"
+    (check-within (hash 'a (list 3) 'b (flvector 10.0 20.0))
+                  (hash 'a (list 2.98) 'b (flvector 9.99 20.01))
+                  0.1))
 
   (make-failure-test "check-= failure > epsilon"
                      check-= 1 12/10 1/10)
+  (make-failure-test "check-within failure > epsilon"
+                     check-within
+                     (list (list 1.0) '() (list 2.0 3.0))
+                     (list (list 1.0) '() (list 2.5 3.0))
+                     0.1)
+  (make-failure-test "check-within failure > epsilon inside an flvector"
+                     check-within
+                     (list 'a (flvector 2.0 3.0))
+                     (list 'a (flvector 2.5 3.0))
+                     0.1)
+  (make-failure-test "check-within failure > epsilon inside an extflvector"
+                     check-within
+                     (list 'a (extflvector 2.0t0 3.0t0))
+                     (list 'a (extflvector 2.5t0 3.0t0))
+                     0.1)
+  (make-failure-test "check-within failure > epsilon inside a hash-table"
+                     check-within
+                     (hash 'a 3.0 'b 10.0)
+                     (hash 'a 3.7 'b 10.0)
+                     0.1)
 
   (test-case "check-as-expression failure"
     (check-exn exn:test:check?