1. David Krentzlin
  2. data-generators

Commits

certainty  committed 18f4896

implemented gen-rational

  • Participants
  • Parent commits 0857a76
  • Branches default

Comments (0)

Files changed (3)

File data-generators-impl.scm

View file
 
 (register-generator-for-type! flonum? gen-real)
 
+(define gen-rational
+  (case-lambda
+    (()
+     (gen-rational (fixnums) (fixnums)))
+    ((nom-gen denom-gen)
+     (let ((ensure-not-zero (lambda (val)
+                              (if (zero? val)
+                                  (<- (gen-fixnum 1 (gen-current-fixnum-max)))
+                                  val))))
+       (generator
+        (let ((nom (<- nom-gen))
+              (denom (ensure-not-zero (<- denom-gen))))
+          (/ nom denom)))))))
+
+(define rationals gen-rational)
+
 (define gen-series
   (case-lambda
     (() (gen-series (gen-current-fixnum-min) (gen-current-fixnum-max) add1))

File data-generators.scm

View file
    gen-current-default-size
    generator <- gen-for-each register-generator-for-type! gen
    gen-constant  gen-int8 gen-uint8 gen-int16 gen-uint16 gen-int32 gen-uint32 gen-int64 gen-uint64 fixnums even-fixnums odd-fixnums flonums
-   gen-bool booleans gen-series gen-char chars gen-fixnum gen-even-fixnum gen-odd-fixnum gen-real gen-sample gen-sample-of gen-pair-of gen-tuple-of
+   gen-bool booleans gen-series gen-char chars gen-fixnum gen-even-fixnum gen-odd-fixnum gen-real gen-rational gen-sample gen-sample-of gen-pair-of gen-tuple-of
    gen-list-of gen-alist-of gen-vector-of gen-string-of gen-symbol-of gen-symbol gen-keyword-of gen-keyword gen-procedure gen-hash-table-of gen-record gen-values-of gen-transform
    with-size range size-spec->gen)
   (import chicken scheme)

File tests/run.scm

View file
     (test-error "lower bound <= upper bound"
      (gen-real 2.0 1.0)))
 
+(test-group "gen-rational"
+            (test-assert "creates a rational"
+                         (every rational? (<-* (gen-rational))))
+            (test-assert "it ensures non-zero denominator"
+                         (begin (<-* (gen-rational (fixnums) (gen-constant 0))) #t)))
+
 (test-group "gen-series"
             (test "works for integers"
              (list 1 2 3 4)