dependencies
| (this space intentionally left almost blank) | |||||||||
Suite of tests to verify that a given system implementation conforms to the spec during a sequence of operations performed on it. | (ns test.carly.core
(:require
[clojure.test :as ctest]
[clojure.test.check.generators :as gen]
(test.carly
[check :as check]
[op :as op]
[report :as report]
[search :as search]))) | |||||||||
Test Operation Definition | ||||||||||
Macro helper to build a generator constructor. | (defn- generator-body
[op-name [form :as body]]
(cond
(and (= 1 (count body)) (vector? form))
`(gen/fmap
(partial apply ~(symbol (str "->" (name op-name))))
(gen/tuple ~@form))
(and (= 1 (count body)) (map? form))
`(gen/fmap
~(symbol (str "map->" (name op-name)))
(gen/hash-map ~@(apply concat form)))
:else
`(gen/fmap
~(symbol (str "map->" (name op-name)))
(do ~@body)))) | |||||||||
Defines a new specification for a system operation test. | (defmacro defop
[op-name attr-vec & forms]
(let [defined (zipmap (map first forms) forms)]
(when-let [unknown-forms (seq (dissoc defined 'gen-args 'apply-op 'check 'update-model))]
(throw (ex-info "Unknown forms defined in operation body"
{:unknown (map first unknown-forms)})))
`(do
(defrecord ~op-name
~attr-vec
op/TestOperation
~(or (defined 'apply-op)
'(apply-op [op system] nil))
~(if-let [[sym args & body] (defined 'check)]
(list sym args (report/wrap-report-check body))
'(check [op model result] true))
~(or (defined 'update-model)
'(update-model [op model] model)))
(defn ~(symbol (str "gen->" (name op-name)))
~(str "Constructs a " (name op-name) " operation generator.")
~@(if-let [[_ args & body] (defined 'gen-args)]
[args (generator-body op-name body)]
[['context]
`(gen/return (~(symbol (str "->" (name op-name)))))]))))) | |||||||||
(defop Wait
[duration]
(gen-args
[_]
[(gen/choose 1 100)])
(apply-op
[this system]
(Thread/sleep duration))) | ||||||||||
Takes a function from context to vector of op generators and returns a new function which additionally returns the wait op as the first result | (defn- waitable-ops [op-generators] (comp (partial cons (gen->Wait nil)) op-generators)) | |||||||||
Test Harness | ||||||||||
Create a generator for inputs to a system under test. This generator produces a context and a collection of sequences of operations generated from the context. | (defn- gen-test-inputs
[context-gen ctx->op-gens max-concurrency]
(gen/bind
(gen/tuple
context-gen
(if (<= max-concurrency 1)
(gen/return 1)
(gen/choose 1 max-concurrency)))
(fn [[context concurrency]]
(gen/tuple
(gen/return context)
(-> (ctx->op-gens context)
(gen/one-of)
(gen/list)
(gen/not-empty)
(gen/vector concurrency)))))) | |||||||||
Returns the number of milliseconds elapsed since an initial start time in system nanoseconds. | (defn- elapsed-since [start] (/ (- (System/nanoTime) start) 1000000.0)) | |||||||||
Construct a system, run a collection of op sequences on the system (possibly concurrently), and shut the system down. Returns a map from thread index to operations updated with results. | (defn- run-ops!
[constructor finalize! op-seqs]
(let [start (System/nanoTime)
system (constructor)]
(try
(case (count op-seqs)
0 op-seqs
1 {0 (op/apply-ops! system (first op-seqs))}
(op/run-threads! system op-seqs))
(finally
(when finalize!
(finalize! system))
(ctest/do-report
{:type ::report/run-ops
:op-count (reduce + 0 (map count op-seqs))
:concurrency (count op-seqs)
:elapsed (elapsed-since start)}))))) | |||||||||
Runs a generative test iteration. Returns a test result map. | (defn- run-test!
[constructor finalize! model thread-count op-seqs]
(ctest/do-report
{:type ::report/test-start})
(let [op-results (run-ops! constructor finalize! op-seqs)
result (search/search-worldlines thread-count model op-results)]
(ctest/do-report
(assoc result :type (if (:world result)
::report/test-pass
::report/test-fail)))
(assoc result :op-results op-results))) | |||||||||
Run a generative trial involving multiple test repetitions. | (defn- run-trial!
[repetitions runner-fn op-seqs]
(let [start (System/nanoTime)]
(ctest/do-report
{:type ::report/trial-start
:repetitions repetitions
:concurrency (count op-seqs)
:op-count (reduce + 0 (map count op-seqs))})
(loop [i 0
result nil]
(if (== repetitions i)
(do (ctest/do-report
{:type ::report/trial-pass
:repetitions repetitions
:elapsed (elapsed-since start)})
result)
(let [result (runner-fn op-seqs)]
(if (:world result)
(recur (inc i) result)
(do (ctest/do-report
{:type ::report/trial-fail
:repetition (inc i)
:elapsed (elapsed-since start)})
result))))))) | |||||||||
Emit clojure.test reports for the summarized results of the generative tests. | (defn- report-test-summary
[summary]
(if (and (:result summary) (not (instance? Throwable (:result summary))))
(ctest/report
(assoc summary :type ::report/summary))
(ctest/report
(assoc summary
:type ::report/shrunk
:shrunk-result (::check/result (meta (get-in summary [:shrunk :smallest]))))))) | |||||||||
Uses generative tests to validate the behavior of a system under a linear sequence of operations. Takes a test message, a single-argument constructor function which takes the context and produces a new system for testing, and a function which will return a vector of operation generators when called with the test context. The remaining options control the behavior of the tests:
| (defn check-system
[message
iteration-opts
init-system
ctx->op-gens
& {:keys [context-gen init-model finalize!
concurrency repetitions search-threads]
:or {context-gen (gen/return {})
init-model (constantly {})
concurrency 4
repetitions 5
search-threads (. (Runtime/getRuntime) availableProcessors)}
:as opts}]
{:pre [(fn? init-system) (fn? ctx->op-gens)]}
(ctest/testing message
(binding [report/*options* (merge report/*options* (:report opts))]
(report-test-summary
(check/check-and-report
iteration-opts
(gen-test-inputs
context-gen
(cond-> ctx->op-gens
(< 1 concurrency) (waitable-ops))
concurrency)
(fn [ctx op-seqs]
(let [model (init-model ctx)
constructor (fn system-constructor
[]
(try
(init-system ctx)
(catch clojure.lang.ArityException ae
(init-system))))]
(run-trial!
repetitions
(partial run-test!
constructor
finalize!
model
search-threads)
op-seqs)))))))) | |||||||||
Functions for running concurrent workers to search for valid worldlines. | (ns test.carly.search
(:require
[clojure.test :as ctest]
[test.carly.world :as world])
(:import
(java.util.concurrent
PriorityBlockingQueue
TimeUnit))) | |||||||||
Ranks two worlds by the number of possible futures they have. Worlds with fewer futures will rank earlier. | (defn- compare-futures [a b] (compare (:futures a) (:futures b))) | |||||||||
Steps a world forward to completion along a linear track. Returns a valid
terminal world if the operations end in a valid state, otherwise nil. Calls
| (defn- run-linear
[world f]
(when world
(f world)
(if (world/end-of-line? world)
; Made it to the end of the world line with consistent results.
world
; Step world forward. A nil here means the next operation result
; is invalid, so the observed worldline is inconsistent with the
; model.
(recur (world/step world) f)))) | |||||||||
Poll the queue for a world, calculate next states, and add valid ones back
into the queue. The | (defn- spawn-worker!
[^PriorityBlockingQueue queue report-fn visited result]
(future
(loop []
(when-not (realized? result)
(if-let [world (.poll queue 100 TimeUnit/MILLISECONDS)]
(let [mark-visited! #(swap! visited conj (world/visit-key %))
visited? #(contains? @visited (world/visit-key %))]
(when-not (visited? world)
; Add world to visited set.
(mark-visited! world)
; Compute steps.
(binding [ctest/report report-fn]
(if (<= (:futures world) 1)
; Optimization to run the linear sequence directly when there is only one
; possible future worldline.
(when-let [end (run-linear world mark-visited!)]
(deliver result end))
; Otherwise, calculate the next possible states and add any unvisited
; ones to the queue.
(->> (world/next-steps world)
(remove visited?)
(run! #(.offer queue %))))))
(recur))
; Didn't find a world; if the queue is still empty, deliver nil.
(when (empty? queue)
(deliver result nil))))))) | |||||||||
Run a collection of worker threads to consume the given queue of worlds. Blocks and returns the first valid world found, or nil, once all the threads have terminated. | (defn- run-workers!
[n queue report-fn visited]
(when-not (empty? queue)
(let [result (promise)
workers (repeatedly n #(spawn-worker! queue report-fn visited result))]
(dorun workers)
(run! deref workers)
@result))) | |||||||||
Run a world directly on-thread to perform a linear search. Only appropriate when the world has a single worldline left. | (defn- linear-search
[origin]
(let [visited (volatile! 0)
reports (volatile! [])
start (System/nanoTime)
valid-world (binding [ctest/report #(vswap! reports conj %)]
(run-linear origin (fn [world] (vswap! visited inc))))
elapsed (/ (- (System/nanoTime) start) 1000000.0)]
{:world valid-world
:threads 1
:futures 1
:visited @visited
:reports @reports
:elapsed elapsed})) | |||||||||
Run up to | (defn- parallel-search
[origin thread-count]
(let [visited (atom #{})
reports (atom [])
queue (doto (PriorityBlockingQueue. 20 compare-futures)
(.offer origin))
start (System/nanoTime)
valid-world (run-workers! thread-count queue (partial swap! reports conj) visited)
elapsed (/ (- (System/nanoTime) start) 1000000.0)]
{:world valid-world
:threads thread-count
:futures (:futures origin)
:visited (count @visited)
:reports @reports
:elapsed elapsed})) | |||||||||
Run up to | (defn search-worldlines
[thread-count model thread-results]
(when (empty? thread-results)
(throw (RuntimeException.
"Cannot search the worldless void (thread results were empty)")))
(let [origin (world/initialize model thread-results)]
(if (= 1 (:futures origin))
(linear-search origin)
(parallel-search origin thread-count)))) | |||||||||
Test operations and related functionality. | (ns test.carly.op) | |||||||||
Protocol for a test operation on a system. | (defprotocol TestOperation
(apply-op
[operation system]
"Apply the operation to the system, returning a result value.")
(check
[operation model result]
"Validate an operation given the model state and the response from the
system being tested. May include `clojure.test/is` assertions, and should
return a boolean value indicating overall success or failure.")
(update-model
[operation model]
"Apply an update to the model based on the operation.")) | |||||||||
Apply a sequence of operations to a system, returning a vector of pairs of the operations with their results. | (defn apply-ops!
[system ops]
(mapv
(fn [op]
(assoc
op ::result
(try
(apply-op op system)
(catch Throwable t
t))))
ops)) | |||||||||
Applies a sequence of operations in a separate thread. Returns a promise for the results of the application. | (defn run-ops! [latch system thread-id ops] (future @latch (apply-ops! system ops))) | |||||||||
Run each of the given operation sequences in a separate thread. Returns a vector of the operation results for each thread. | (defn run-threads!
[system op-seqs]
(let [latch (promise)
threads (map (partial run-ops! latch system) (range) op-seqs)]
(dorun threads)
(deliver latch :start)
; TODO: timeout on deref?
(->> (map deref threads)
(map vector (range))
(into {})))) | |||||||||
Record and functions for simulating world states. Each world is represented by an immutable map containing the model state, current history, and map of pending thread operations. | (ns test.carly.world
(:require
[test.carly.op :as op])) | |||||||||
A world represents a point in time along a possible history. The | (defrecord World [model history pending futures]) | |||||||||
Determine whether the worldline has ended. | (defn end-of-line? [world] (empty? (:pending world))) | |||||||||
Get the next pending operation for the identified thread, if any. | (defn- peek-pending [pending thread-id] (first (get pending thread-id))) | |||||||||
Remove the next pending operation for the identified thread. Returns an updated map with the remaining ops, or without the thread if no ops were left. | (defn- pop-pending
[pending thread-id]
(let [[_ & more] (get pending thread-id)]
(if (seq more)
(assoc pending thread-id more)
(dissoc pending thread-id)))) | |||||||||
Calculate the number of possible futures a world has based on a map of thread ids to pending operations. | (defn- future-count
[pending]
(if (<= (count pending) 1)
1
(let [fact (fn fact [n] (reduce * 1N (map inc (range n))))
op-counts (map count (vals pending))]
(apply / (fact (reduce + op-counts)) (map fact op-counts))))) | |||||||||
Initialize a new world state given the initial model and a map of pending operations. | (defn initialize
[model pending]
(map->World
{:model model
:history []
:pending pending
:futures (future-count pending)})) | |||||||||
Compute a step by applying the next operation from the identified thread to the world. Returns an updated world state, or nil if the operation result was invalid. | (defn step
([world]
(step world (first (keys (:pending world)))))
([world thread-id]
(let [op (peek-pending (:pending world) thread-id)]
(when-not op
(throw (IllegalStateException.
(format "Cannot step thread %d - no ops pending" thread-id))))
(when-not (contains? op ::op/result)
(throw (IllegalStateException.
(format "Cannot step op %s with no result" (pr-str op)))))
(when (op/check op (:model world) (::op/result op))
(-> world
(update :model (partial op/update-model op))
(update :history conj (assoc op ::thread thread-id))
(update :pending pop-pending thread-id)
(as-> w (assoc w :futures (future-count (:pending w))))))))) | |||||||||
Compute all possible valid next steps for the world, returning a sequence of new world states. | (defn next-steps [world] (keep (partial step world) (keys (:pending world)))) | |||||||||
Return the key used to compare worlds which are equivalent nodes in the graph of possible futures. | (defn visit-key [world] [(:model world) (:pending world)]) | |||||||||
Integration code for wedding generative | (ns test.carly.check
(:require
[clojure.test.check :as tc]
[clojure.test.check.clojure-test :as tcct]
[clojure.test.check.generators :as gen])) | |||||||||
Helper to produce a property by applying the test function to a realized
set of arguments from some bound generator. The function should accept a
context map and a collection of op sequences, and return a result map with a
| (defn- apply-test
[function]
(fn [args]
(try
(let [result (apply function args)]
{:result (boolean (:world result))
:function function
; XXX: Super gross, but we need to do this to get result metadata
; through for failing results until test.check 0.10.0. ಠ_ಠ
:args (vary-meta args assoc ::result result)})
(catch ThreadDeath td
(throw td))
(catch Throwable ex
{:result ex
:function function
:args args})))) | |||||||||
Apply generative tests to the given input generator and testing function, returning a test.check summary. | (defn check-and-report
[opts gen-inputs f]
(let [opts (tcct/process-options opts)]
(apply tc/quick-check
(:num-tests opts 20)
(gen/fmap (apply-test f) gen-inputs)
(apply concat (dissoc opts :num-tests))))) | |||||||||
Integration code for wedding generative | (ns test.carly.report
(:require
[clojure.string :as str]
[clojure.test :as ctest]
[puget.color.ansi :as ansi]
[puget.printer :as puget])) | |||||||||
Looks up an environment variable and returns a keywordized value if it is present, or nil if not. | (defn- env-keyword
[env-key default]
(if-let [env-val(System/getenv env-key)]
(keyword (str/lower-case env-val))
default)) | |||||||||
Report output options. | (def ^:dynamic *options*
{:style (env-keyword "TEST_CARLY_STYLE" :dots)
:print-color (not (contains? #{:0 :false :no}
(env-keyword "TEST_CARLY_COLOR" true)))
:puget {}}) | |||||||||
Applies ANSI coloring to the given text, if the print-color option is true. | (defn- colorize
[text & codes]
(if (:print-color *options*)
(apply ansi/sgr text codes)
text)) | |||||||||
Pretty-print the given value using the dynamic reporting options. | (defn- pprint [x] (puget/pprint x (assoc (:puget *options*) :print-color (:print-color *options*)))) | |||||||||
Apply common formatting to elapsed times. | (defn- format-duration [elapsed] (colorize (format "%.2f ms" elapsed) :cyan)) | |||||||||
Report Methods | ||||||||||
Report the beginning of a new test trial. Check forms produce one trial per generative iteration, so there may be more if shrinking is necessary. | (defmethod ctest/report ::trial-start
[result]
(ctest/with-test-out
(case (:style *options*)
:verbose
(printf "\n%s Starting %s trial%s with %s operations%s %s\n"
(colorize "<<<" :bold :blue)
(colorize "test.carly" :magenta)
(if (< 1 (:repetitions result))
(colorize (str " x" (:repetitions result)) :cyan)
"")
(colorize (:op-count result) :bold :yellow)
(if (< 1 (:concurrency result))
(str " across " (colorize (:concurrency result) :cyan) " threads")
"")
(colorize ">>>" :bold :blue))
:terse
(do (printf "%12s/%-10s | "
(colorize (:op-count result) :cyan)
(colorize (:concurrency result) :bold :yellow))
(flush))
; otherwise silent
nil))) | |||||||||
Start of a test repetition. This is mainly useful as a marker. | (defmethod ctest/report ::test-start
[result]
(ctest/with-test-out
(ctest/inc-report-counter :test)
(case (:style *options*)
:verbose
(println " Starting test repetition...")
; otherwise silent
nil))) | |||||||||
Elapsed time to run the operations against a real system. | (defmethod ctest/report ::run-ops
[result]
(ctest/with-test-out
(case (:style *options*)
:verbose
(printf " Ran ops in %s\n" (format-duration (:elapsed result)))
; otherwise silent
nil))) | |||||||||
Common reporting code for assertions at the end of a test. | (defn- report-assertions
[result]
(let [assertions (frequencies (map :type (:reports result)))
total (reduce + 0 (vals assertions))]
; Record every assertion as a :pass, since failures during searches are not
; real failures.
(when ctest/*report-counters*
(dosync
(commute ctest/*report-counters* update :pass (fnil + 0) total)))
; Print out assertion counts
(case (:style *options*)
:verbose
(printf " Checked %s assertions (%d passed, %d failed, %d errors)\n"
(colorize total :cyan)
(:pass assertions 0)
(:fail assertions 0)
(:error assertions 0))
; Otherwise no-op
nil))) | |||||||||
Report that a test repetition passed successfully, indicating that a valid worldline was found. | (defmethod ctest/report ::test-pass
[result]
; TODO: option to show valid linearization
(ctest/with-test-out
(ctest/inc-report-counter :pass)
(report-assertions result)
(case (:style *options*)
:verbose
(printf " Found valid worldline among %s futures in %s after visiting %s worlds.\n"
(colorize (:futures result) :cyan)
(format-duration (:elapsed result))
(colorize (:visited result) :cyan))
(:terse :dots)
(do (print (colorize "." :green))
(flush))
; Otherwise no-op
nil))) | |||||||||
Report that a test repetition failed, indicating that no valid worldline could be found for the observed operation results. | (defmethod ctest/report ::test-fail
[result]
(ctest/with-test-out
(ctest/inc-report-counter :fail)
(report-assertions result)
(case (:style *options*)
:verbose
(printf " Exhausted valid worldlines among %s futures in %s after visiting %s worlds!\n"
(colorize (:futures result) :cyan)
(format-duration (:elapsed result))
(colorize (:visited result) :cyan))
(:terse :dots)
(do (print (colorize "." :red))
(flush))
; Otherwise no-op
nil))) | |||||||||
An entire test trial passed, meaning every repetition was successful. | (defmethod ctest/report ::trial-pass
[result]
(ctest/with-test-out
(case (:style *options*)
:verbose
(printf "Trial %s in %s\n"
(colorize "PASSED" :bold :green)
(format-duration (:elapsed result)))
:terse
(do (print (colorize "✓" :bold :green)
" "
(format-duration (:elapsed result)))
(newline)
(flush))
; Otherwise no-op
nil))) | |||||||||
An entire trial failed, indicating that one or more repetitions was unsuccessful. | (defmethod ctest/report ::trial-fail
[result]
(ctest/with-test-out
(case (:style *options*)
:verbose
(printf "Trial %s in %s after %s tests\n"
(colorize "FAILED" :bold :red)
(format-duration (:elapsed result))
(colorize (:repetition result) :cyan))
:terse
(do (print (colorize "X" :bold :red))
(newline)
(flush))
; Otherwise no-op
nil))) | |||||||||
Report a successful generative test summary. | (defmethod ctest/report ::summary
[summary]
(ctest/with-test-out
; TODO: summarize total assertion counts if possible
(printf "\nGenerative tests passed after %s trials with seed %s\n"
(colorize (:num-tests summary) :cyan)
(colorize (:seed summary) :green)))) | |||||||||
Report the shrunk value of a failed test summary. | (defmethod ctest/report ::shrunk
[summary]
#_ ; fail
{:result false-or-exception
:seed seed
:failing-size size
:num-tests (inc trial-number)
:fail (vec failing-args)
:shrunk {:total-nodes-visited total-nodes-visited
:depth depth
:result (:result smallest)
:smallest (:args smallest)}
:shrunk-result {:world nil
:threads n
:futures n
:visited n
:reports [,,,]
:elapsed ms}}
(ctest/with-test-out
(newline)
(printf "Tests failed with seed %s\n"
(colorize (:seed summary) :red))
(when-let [shrunk (:shrunk summary)]
(printf "Shrank inputs %s steps after searching %s nodes\n"
(colorize (:depth shrunk) :cyan)
(colorize (:total-nodes-visited shrunk) :cyan)))
(when-let [[context op-seqs] (get-in summary
[:shrunk :smallest]
(:fail summary))]
(newline)
(println "Context:")
(pprint context)
(newline)
(println "Operation sequences:")
(doseq [[i ops] (or (get-in summary [:shrunk-result :op-results])
(zipmap (range) op-seqs))]
(printf "thread #%d\n" (inc i))
(doseq [op ops]
(if (contains? op :test.carly.op/result)
(pprint [(dissoc op :test.carly.op/result) '=> (:test.carly.op/result op)])
(pprint op)))))
(newline)
(println "Failing assertions:")
(run!
(fn [report]
; {:file "table_test.clj", :line 131, :type :fail, :expected (coll? result), :actual (not (coll? nil)), :message nil}
(when (#{:fail :error} (:type report))
(printf "%s:%s %s\n\tExpected: %s\tActual: %s"
(:file report) (:line report)
(or (:message report) "")
(with-out-str (pprint (:expected report)))
(with-out-str (pprint (:actual report))))))
(get-in summary [:shrunk-result :reports]))
(newline)
(println "Result:")
(let [result (get-in summary [:shrunk :result] (:result summary))]
(if (instance? Throwable result)
(clojure.stacktrace/print-cause-trace result)
(pprint result))))) | |||||||||
Helper Functions | ||||||||||
Capture any clojure.test reports generated by the body. Returns a vector containing the evaluated result, followed by a vector of reports. | (defmacro capture-reports
[& body]
`(let [reports# (atom [])]
[(binding [ctest/report (partial swap! reports# conj)]
~@body)
@reports#])) | |||||||||
Publish a collection of reports to clojure.test. | (defn publish! [reports] (run! ctest/report reports)) | |||||||||
Wrap the given sequence of forms such that it returns false if there is a failed clojure.test assertion in the body. If there are no assertions, returns the result of evaluating the body. | (defn wrap-report-check
[body]
`(let [[result# reports#] (capture-reports ~@body)]
(publish! reports#)
(if (empty? reports#)
result#
(not (some (comp #{:fail :error} :type) reports#))))) | |||||||||