Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

301 lines (247 sloc) 8.068 kb
; Copyright (c) Rich Hickey, Stuart Halloway, and contributors.
; All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (
; which can be found in the file epl-v10.html at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.
(ns ^{:author "Stuart Halloway"
:doc "Generators for clojure.test.generative.
The functions in this namespace define the DSL for generator
specs. You do not want to use this namespace directly in most
cases, because
1. Spec compilation uses these fns for you automatically.
2. There are lot of collisions with clojure.core!"}
(:refer-clojure :exclude [byte char long int short float double boolean string symbol keyword list vec set hash-map name rand-nth byte-array boolean-array short-array char-array int-array long-array float-array double-array shuffle])
(:require [clojure.core :as core]))
(def ^:dynamic ^java.util.Random
"Random instance for use in generators. By consistently using this
instance you can get a repeatable basis for tests."
(java.util.Random. 42))
(def ^:dynamic
"Seed for random generator, rebind this to change your basis."
(defn- call-through
"Recursively call x until it doesn't return a function."
(if (fn? x)
(recur (x))
(defn reps
"Returns sizer repetitions of f (or (f) if f is a fn)."
[sizer f]
(let [count (call-through sizer)]
(if (fn? f)
(repeatedly count f)
(repeat count f))))
(defn geometric
"Geometric distribution with mean 1/p."
^long [p]
(core/long (Math/ceil (/ (Math/log (.nextDouble *rnd*))
(Math/log (- 1.0 p))))))
(defn uniform
"Uniform distribution from lo (inclusive) to high (exclusive).
Defaults to range of Java long."
(^long [] (.nextLong *rnd*))
(^long[lo hi] {:pre [(< lo hi)]}
(clojure.core/long (Math/floor (+ lo (* (.nextDouble *rnd*) (- hi lo)))))))
(defn float
"Generate a float."
^double []
(Float/intBitsToFloat (.nextInt *rnd*)))
(defn double
"Generate a double."
^double []
(.nextDouble *rnd*))
(defn rand-nth
"Replacement of core/rand-nth that allows control of the
randomization basis (through binding *seed*)."
(nth coll (uniform 0 (count coll))))
(defn tuple
"Generate a tuple with one element from each generator."
[& generators]
(into [] (map #(%) generators)))
(defn weighted
"Given a map of generators and weights, return a value from one of
the generators, selecting generator based on weights."
(let [weights (reductions + (vals m))
total (last weights)
choices (map vector (keys m) weights)]
(let [choice (uniform 0 total)]
(loop [[[c w] & more] choices]
(when w
(if (< choice w)
(call-through c)
(recur more)))))))
(defn one-of
"Generates one of the specs passed in, with equal probability."
([& specs]
(weighted (zipmap specs (repeat 1)))))
(def long
"Returns a random long. Same as uniform."
(defn int
"Returns a random long in the int range."
(uniform Integer/MIN_VALUE (inc Integer/MAX_VALUE)))
(defn short
"Returns a random long in the short range."
(uniform Short/MIN_VALUE (inc (core/long Short/MAX_VALUE))))
(defn byte
"Returns a random long in the byte range."
^long []
(uniform Byte/MIN_VALUE (inc (core/int Byte/MAX_VALUE))))
(defn boolean
"Returns a random bool."
(< (.nextDouble *rnd*) 0.5))
(defn printable-ascii-char
"Returns a random printable ascii character."
(core/char (uniform 32 127)))
(defn char
"Returns a random character in the range 0-65536."
(core/char (uniform 0 65536)))
(defn default-sizer
"Default sizer used to run tests. If you want a specific distribution,
create your own and pass it to a fn that wants a sizer."
(dec (geometric 0.02)))
(defn list
"Create a list with elements from f and sized from sizer."
([f] (list f default-sizer))
([f sizer]
(reps sizer f)))
(defmacro primitive-array
(let [fn-name (core/symbol (str type "-array"))
factory-name (core/symbol (str "core/" fn-name))
cast-name (core/symbol (str "core/" type))]
`(defn ~fn-name
"Create an array with elements from f and sized from sizer."
(~fn-name ~'f default-sizer))
([~'f ~'sizer]
(let [~'arr (~factory-name (call-through ~'sizer))]
(dotimes [~'i (count ~'arr)]
(aset ~'arr ~'i (~cast-name (call-through ~'f))))
(defmacro primitive-arrays
`(do ~@(map (fn [type] `(primitive-array ~type)) types)))
(primitive-arrays ["byte" "short" "long" "char" "double" "float" "int" "boolean"])
#_(defn byte-array
(byte-array f default-sizer))
([f sizer]
(let [arr (core/byte-array (call-through default-sizer))]
(dotimes [i (count arr)]
(aset arr i (core/byte (call-through f))))
(defn vec
"Create a vec with elements from f and sized from sizer."
([f] (vec f default-sizer))
([f sizer]
(into [] (reps sizer f))))
(defn set
"Create a set with elements from f and sized from sizer."
([f] (set f default-sizer))
([f sizer]
(into #{} (reps sizer f))))
(defn hash-map
"Create a hash-map with keys from fk, vals from fv, and
sized from sizer."
([fk fv] (hash-map fk fv default-sizer))
([fk fv sizer]
(into {}
(zipmap (reps sizer fk)
(reps sizer fv)))))
(defn string
"Create a string with chars from v and sized from sizer."
([] (string printable-ascii-char))
([f] (string f default-sizer))
([f sizer] (apply str (reps sizer f))))
(def ^:private ascii-alpha
(concat (range 65 (+ 65 26))
(range 97 (+ 97 26))))
(def ^:private symbol-start
(-> (concat ascii-alpha [\* \+ \! \- \_ \?])
(def ^:private symbol-char
(into symbol-start [\1 \2 \3 \4 \5 \6 \7 \8 \9 \0]))
;; cannot generate every legal prefix, but at least avoids
;; the illegal "-1"
(defn- name-prefix
(str (rand-nth [(core/char (rand-nth symbol-start)) ""])
(core/char (rand-nth ascii-alpha))))
(defn- name-body
(string #(core/char (rand-nth symbol-char)) sizer))
(defn- name
([] (name default-sizer))
(str (name-prefix)
(name-body sizer))))
(defn symbol
"Create a symbol sized from sizer."
([] (core/symbol (name)))
(core/symbol (name sizer))))
(defn keyword
"Create a keyword sized from sizer."
([] (core/keyword (name)))
(core/keyword (name sizer))))
(def scalars
[(constantly nil)
(defn scalar
"Returns a random scalar."
(call-through (rand-nth scalars)))
(def collections
[[vec [scalars]]
[set [scalars]]
[hash-map [scalars scalars]]])
(defn collection
"Returns a random collection of scalar elements."
(let [[coll args] (rand-nth collections)]
(apply coll (map rand-nth args))))
(defn anything
"Returns a random scalar or collection."
(one-of scalar collection))
(defn ^:private fisher-yates
(let [as (object-array coll)]
(loop [i (dec (count as))]
(if (<= 1 i)
(let [j (uniform 0 (inc i))
t (aget as i)]
(aset as i (aget as j))
(aset as j t)
(recur (dec i)))
(into (empty coll) (seq as))))))
(defn shuffle
"Shuffle coll"
;; using our own fischer-yates instead of core/shuffle so that
;; we'll get the same shuffle, given the same random *seed*.
(fisher-yates coll))
Jump to Line
Something went wrong with that request. Please try again.