1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
(ns clojure.test-clojure.generators
(:require [clojure.data.generators :as gen])
(:refer-clojure :exclude [namespace]))
(defn var-value-source
"Generates a scalar suitable for an initial var value."
[]
(let [v (gen/scalar)]
(if (symbol? v)
`(quote ~v)
v)))
(defn var-source
[n]
`(def ~(symbol (str "var" n))
~(var-value-source)))
(defn record-source
[n]
(let [rname (str "ExampleRecord" "-" n)
fldct (gen/geometric 0.1)]
`(defrecord ~(symbol rname) ~(vec (map #(symbol (str "f" %)) (range fldct))))))
(defn generate-namespaces
"Returns a map with :nses, :vars, :records"
[{:keys [nses vars-per-ns records-per-ns]}]
(let [nses (mapv #(create-ns (symbol (str "clojure.generated.ns" %)))
(range nses))
_ (doseq [ns nses] (binding [*ns* ns] (refer 'clojure.core)))
make-in-ns (fn [ns src] (binding [*ns* ns] (eval src)))
vars (->> (mapcat
(fn [ns]
(map
#(make-in-ns ns (var-source %))
(range vars-per-ns)))
nses)
(into []))
records (->> (mapcat
(fn [ns]
(map
#(make-in-ns ns (record-source %))
(range records-per-ns)))
nses)
(into []))]
{:nses nses
:vars vars
:records records}))
(def shared-generation
(delay (generate-namespaces {:nses 5 :vars-per-ns 5 :records-per-ns 5})))
(defn namespace
[]
(gen/rand-nth (:nses @shared-generation)))
(defn var
[]
(gen/rand-nth (:vars @shared-generation)))
(defn record
[]
(gen/rand-nth (:records @shared-generation)))
(def keyword-pool
(delay
(binding [gen/*rnd* (java.util.Random. 42)]
(into [] (repeatedly 1000 gen/keyword)))))
(defn keyword-from-pool
[]
(gen/rand-nth @keyword-pool))
(def symbol-pool
(delay
(binding [gen/*rnd* (java.util.Random. 42)]
(into [] (repeatedly 1000 gen/symbol)))))
(defn symbol-from-pool
[]
(gen/rand-nth @keyword-pool))
(def ednable-scalars
[(constantly nil)
gen/byte
gen/long
gen/boolean
gen/printable-ascii-char
gen/string
symbol-from-pool
keyword-from-pool
gen/uuid
gen/date
gen/ratio
gen/bigint
gen/bigdec])
(defn- call-through
"Recursively call x until it doesn't return a function."
[x]
(if (fn? x)
(recur (x))
x))
(defn ednable-scalar
[]
(call-through (rand-nth ednable-scalars)))
(def ednable-collections
[[gen/vec [ednable-scalars]]
[gen/set [ednable-scalars]]
[gen/hash-map [ednable-scalars ednable-scalars]]])
(defn ednable-collection
[]
(let [[coll args] (rand-nth ednable-collections)]
(apply coll (map rand-nth args))))
(defn ednable
[]
(gen/one-of ednable-scalar ednable-collection))
(defn non-ednable
"Generate something that can be printed with *print-dup*, but
cannot be read back via edn/read."
[]
(gen/one-of namespace var))
(defn dup-readable
"Generate something that requires print-dup to be printed in
a roundtrippable way."
[]
(gen/one-of namespace var))
|
