-
Notifications
You must be signed in to change notification settings - Fork 11
/
runner.clj
99 lines (91 loc) · 4.49 KB
/
runner.clj
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
(ns stateful-check.runner
(:require [stateful-check.command-utils :as u]
[stateful-check.symbolic-values :as sv]))
(defn make-sequential-runners [cmd-objs]
(mapv (fn [[handle cmd-obj & args]]
(if-let [function (:command cmd-obj)]
[handle #(apply function (sv/get-real-value args %))]
(throw (AssertionError. (str "No :command function found for "
(:name cmd-obj)
" command")))))
cmd-objs))
(defrecord CaughtException [exception])
(defn run-sequential-runners [runners bindings assume-immutable-results]
(reduce (fn [[bindings trace str-trace] [handle f]]
(try
(let [value (f bindings)]
[(assoc bindings handle value)
(conj trace value)
(if assume-immutable-results
(conj str-trace nil)
(conj str-trace (pr-str value)))])
(catch Exception exception
(reduced [bindings
(conj trace (->CaughtException exception))
(if assume-immutable-results
(conj str-trace nil)
(conj str-trace exception))
exception]))))
[bindings [] []]
runners))
(defn commands->runners [{:keys [sequential parallel]}]
{:sequential (make-sequential-runners sequential)
:parallel (mapv make-sequential-runners parallel)})
(defmacro with-timeout [timeout-ms & body]
`(let [timeout-ms# ~timeout-ms]
(if (<= timeout-ms# 0)
(do ~@body)
(let [f# (future ~@body)
v# (deref f# timeout-ms# ::timeout)]
(if (= v# ::timeout)
(do (future-cancel f#)
(throw (InterruptedException. "Timed out")))
v#)))))
(defn runners->results [{:keys [sequential parallel]} bindings timeout-ms assume-immutable-results]
(try
(with-timeout timeout-ms
(let [[bindings trace str-trace exception] (run-sequential-runners sequential bindings assume-immutable-results)
latch (java.util.concurrent.atomic.AtomicBoolean. true)
futures (when-not exception
(mapv #(future
(while (.get latch)
;; spin until all the futures have been
;; created (this is probably unnecessary,
;; but just in case)
)
(run-sequential-runners % bindings assume-immutable-results))
parallel))]
(try
(.set latch false)
(let [values (mapv deref futures)]
{:sequential trace
:sequential-strings str-trace
:parallel (mapv #(nth % 1) values)
:parallel-strings (mapv #(nth % 2) values)})
(catch InterruptedException ex
(mapv future-cancel futures)))))
(catch InterruptedException ex
(throw (ex-info "Timed out"
{:sequential (mapv (constantly ::unevaluated) sequential)
:sequential-strings (mapv (constantly "???") sequential)
:parallel (mapv #(mapv (constantly ::unevaluated) %) parallel)
:parallel-strings (mapv #(mapv (constantly "???") %) parallel)})))))
(defn failure
"Return a vector of [handle failure] representing which command
failed, and why. Returns nil if no command has failed.
The failure entry is a map with a :message key and an
optional :events key, which contains clojure.test report events of
type :error and :fail that were emitted during the evaluation of the
postcondition."
[cmds-and-traces state bindings]
(first (reduce (fn [[_ state bindings] [[handle cmd-obj & args] result]]
(if (instance? CaughtException result)
(reduced [[handle {:message "Unexpected exception thrown."}]])
(let [replaced-args (sv/get-real-value args bindings)
next-state (u/make-next-state cmd-obj state replaced-args result)]
(if-let [failure (u/check-postcondition cmd-obj state next-state replaced-args result)]
(reduced [[handle failure]])
[nil
next-state
(assoc bindings handle result)]))))
[nil state bindings] cmds-and-traces)))