Hawk0.0.1-SNAPSHOTIt watches your code like a hawk! You like tests, right? Then run them with our state-of-the-art Clojure test runner. | (this space intentionally left almost blank) |
Custom implementations of [[clojure.test/is]] expressions (i.e., implementations of [[clojure.test/assert-expr]]).
| (ns mb.hawk.assert-exprs (:require [clojure.data :as data] [clojure.test :as t] [clojure.walk :as walk] [mb.hawk.assert-exprs.approximately-equal :as approximately-equal] [schema.core :as s])) |
(defmethod t/assert-expr 're= [msg [_ pattern actual]]
`(let [pattern# ~pattern
actual# ~actual
matches?# (when (string? actual#)
(re-matches pattern# actual#))]
(assert (instance? java.util.regex.Pattern pattern#))
(t/do-report
{:type (if matches?# :pass :fail)
:message ~msg
:expected pattern#
:actual actual#
:diffs (when-not matches?#
[[actual# [pattern# nil]]])}))) | |
(defmethod t/assert-expr 'schema=
[message [_ schema actual]]
`(let [schema# ~schema
actual# ~actual
pass?# (nil? (s/check schema# actual#))]
(t/do-report
{:type (if pass?# :pass :fail)
:message ~message
:expected (s/explain schema#)
:actual actual#
:diffs (when-not pass?#
[[actual# [(s/check schema# actual#) nil]]])}))) | |
Convert all record types in | (defn derecordize
[form]
(walk/postwalk
(fn [form]
(if (record? form)
(into {} form)
form))
form)) |
Remove all the extra stuff (i.e. extra map keys or extra sequence elements) from the | (defn- remove-keys-not-in-expected
[expected actual]
(cond
(and (map? expected) (map? actual))
(into {}
(comp (filter (fn [[k _v]]
(contains? expected k)))
(map (fn [[k v]]
[k (remove-keys-not-in-expected (get expected k) v)])))
actual)
(and (sequential? expected)
(sequential? actual))
(cond
(empty? expected) []
(empty? actual) []
:else (into
[(remove-keys-not-in-expected (first expected) (first actual))]
(when (next expected)
(remove-keys-not-in-expected (next expected) (next actual)))))
:else
actual)) |
(defn- partial=-diff [expected actual]
(let [actual' (remove-keys-not-in-expected expected actual)
[only-in-actual only-in-expected] (data/diff actual' expected)]
{:only-in-actual only-in-actual
:only-in-expected only-in-expected
:pass? (if (coll? only-in-expected)
(empty? only-in-expected)
(nil? only-in-expected))})) | |
Impl for | (defn partial=-report
[message expected actual]
(let [expected (derecordize expected)
actual (derecordize actual)
{:keys [only-in-actual only-in-expected pass?]} (partial=-diff expected actual)]
{:type (if pass? :pass :fail)
:message message
:expected expected
:actual actual
:diffs [[actual [only-in-expected only-in-actual]]]})) |
(defmethod t/assert-expr 'partial=
[message [_ expected actual :as form]]
(assert (= (count (rest form)) 2) "partial= expects exactly 2 arguments")
`(t/do-report
(partial=-report ~message ~expected ~actual))) | |
Implementation for | (defn =?-report
[message multifn expected actual]
(let [diff (if multifn
(approximately-equal/=?-diff* multifn expected actual)
(approximately-equal/=?-diff* expected actual))]
{:type (if (not diff) :pass :fail)
:message message
:expected expected
:actual actual
:diffs [[actual [diff nil]]]})) |
(defmethod t/assert-expr '=?
[message [_ & form]]
(let [[multifn expected actual] (case (count form)
2 (cons nil form)
3 form
(throw (ex-info "=? expects either 2 or 3 arguments" {:form form})))]
`(t/do-report (=?-report ~message ~multifn ~expected ~actual)))) | |
See documentation in | (ns mb.hawk.assert-exprs.approximately-equal (:require [clojure.algo.generic.math-functions :as algo.generic.math] [clojure.pprint :as pprint] [malli.core :as m] [malli.error :as me] [methodical.core :as methodical] [schema.core :as s])) |
(set! *warn-on-reflection* true) | |
Multimethod to use to diff two things with | #_{:clj-kondo/ignore [:dynamic-var-not-earmuffed]}
(methodical/defmulti ^:dynamic =?-diff
{:arglists '([expected actual])}
(fn [expected actual]
[(type expected) (type actual)])) |
Add primary methods in map | (defn- add-primary-methods
[m]
(reduce
(fn [multifn [dispatch-value f]]
(methodical/add-primary-method multifn dispatch-value f))
=?-diff
m)) |
Whether to enable Methodical method tracing for debug purposes. | (def ^:dynamic *debug* false) |
(def ^:private ^:dynamic *same* nil) | |
Are | (defn =?-diff*
([expected actual]
(=?-diff* =?-diff expected actual))
([diff-fn expected actual]
(let [diff-fn (if (map? diff-fn)
(add-primary-methods diff-fn)
diff-fn)]
(binding [=?-diff diff-fn
*same* (atom {})]
(if *debug*
(methodical/trace diff-fn expected actual)
(diff-fn expected actual)))))) |
Default method impls | |
(methodical/defmethod =?-diff :default
[expected actual]
(when-not (= expected actual)
(list 'not= expected actual))) | |
(methodical/defmethod =?-diff [Class Object]
[expected-class actual]
(when-not (instance? expected-class actual)
(list 'not (list 'instance? expected-class actual)))) | |
(methodical/defmethod =?-diff [java.util.regex.Pattern String]
[expected-regex s]
(when-not (re-matches expected-regex s)
(list 'not (list 're-matches expected-regex s)))) | |
two regexes should be treated as equal if they're the same pattern. | (methodical/defmethod =?-diff [java.util.regex.Pattern java.util.regex.Pattern]
[expected actual]
(when-not (= (str expected) (str actual))
(list 'not= (list 'str expected) (list 'str actual)))) |
(methodical/defmethod =?-diff [clojure.lang.AFunction Object]
[pred actual]
(when-not (pred actual)
(list 'not (list pred actual)))) | |
(methodical/defmethod =?-diff [clojure.lang.Sequential clojure.lang.Sequential]
[expected actual]
(let [same-size? (= (count expected)
(count actual))]
;; diff items at each index, e.g. (=?-diff (first expected) (first actual)) then (=?-diff (second expected) (second
;; actual)) and so forth. Keep diffing until BOTH sequences are empty.
(loop [diffs []
expected expected
actual actual]
(if (and (empty? expected)
(empty? actual))
;; If there are no more items then return the vector the diffs, if there were any
;; non-nil diffs, OR if the sequences were of different sizes. The diff between [1 2 nil] and [1 2]
;; in [[clojure.data/diff]] is [nil nil nil]; that's what we'll return in this situation too.
(when (or (some some? diffs)
(not same-size?))
diffs)
;; when there is at least element left in either `expected` or `actual`, diff the first item in each. If one of
;; these is empty, it will diff against `nil`, but that's ok, because we will still fail because `same-size?`
;; above will be false
(let [this-diff (=?-diff (first expected) (first actual))]
(recur (conj diffs this-diff) (rest expected) (rest actual))))))) | |
(methodical/defmethod =?-diff [clojure.lang.IPersistentMap clojure.lang.IPersistentMap]
[expected-map actual-map]
(not-empty (into {} (for [[k expected] expected-map
:let [actual (get actual-map k (symbol "nil #_\"key is not present.\))
diff (=?-diff expected actual)]
:when diff]
[k diff])))) | |
(deftype Exactly [expected]) | |
Used inside a =? expression. Results have to be exactly equal as if by =. Use this to get around the normal way =? would compare things. This works inside collections as well. | (defn exactly [expected] (->Exactly expected)) |
(defmethod print-method Exactly [this writer] ((get-method print-dup Exactly) this writer)) | |
(defmethod print-dup Exactly [^Exactly this ^java.io.Writer writer] (.write writer (format "(exactly %s)" (pr-str (.expected this))))) | |
(defmethod pprint/simple-dispatch Exactly [^Exactly this] (pprint/pprint-logical-block :prefix "(exactly " :suffix ")" (pprint/write-out (.expected this)))) | |
(methodical/defmethod =?-diff [Exactly :default]
[^Exactly this actual]
(let [expected (.expected this)]
(when-not (= expected actual)
(list 'not (list '= (list 'exactly expected) actual))))) | |
(deftype Schema [schema]) | |
Used inside a =? expression. Compares things to a schema.core schema. | (defn schema [schema] (->Schema schema)) |
(defmethod print-method Schema [this writer] ((get-method print-dup Schema) this writer)) | |
(defmethod print-dup Schema [^Schema this ^java.io.Writer writer] (.write writer (format "(schema %s)" (pr-str (.schema this))))) | |
(defmethod pprint/simple-dispatch Schema [^Schema this] (pprint/pprint-logical-block :prefix "(malli " :suffix ")" (pprint/write-out (.schema this)))) | |
(methodical/defmethod =?-diff [Schema :default] [^Schema this actual] (s/check (.schema this) actual)) | |
(deftype Malli [schema]) | |
Used inside a =? expression. Compares things to a malli schema. | (defn malli [schema] (->Malli schema)) |
(defmethod print-dup Malli [^Malli this ^java.io.Writer writer] (.write writer (format "(malli %s)" (pr-str (.schema this))))) | |
(defmethod print-method Malli [this writer] ((get-method print-dup Malli) this writer)) | |
(defmethod pprint/simple-dispatch Malli [^Malli this] (pprint/pprint-logical-block :prefix "(malli " :suffix ")" (pprint/write-out (.schema this)))) | |
(methodical/defmethod =?-diff [Malli :default] [^Malli this actual] (me/humanize (m/explain (.schema this) actual))) | |
(deftype Approx [expected epsilon]) | |
Used inside a =? expression. Compares whether two numbers are approximately equal. | (defn approx
[form]
(let [form (eval form)
_ (assert (sequential? form) "Expected (approx [expected epsilon])")
[expected epsilon] form]
(assert (number? expected))
(assert (number? epsilon))
(->Approx expected epsilon))) |
(defmethod print-method Approx [this writer] ((get-method print-dup Approx) this writer)) | |
(defmethod print-dup Approx [^Approx this ^java.io.Writer writer] (.write writer (format "(approx %s)" (pr-str [(.expected this) (.epsilon this)])))) | |
(defmethod pprint/simple-dispatch Approx [^Approx this] (pprint/pprint-logical-block :prefix "(approx " :suffix ")" (pprint/write-out [(.expected this) (.epsilon this)]))) | |
(methodical/defmethod =?-diff [Approx Number]
[^Approx this actual]
(let [expected (.expected this)
epsilon (.epsilon this)]
(when-not (algo.generic.math/approx= expected actual epsilon)
(list 'not (list 'approx expected actual (symbol "#_epsilon") epsilon))))) | |
(deftype Same [k]) | |
Used inside a =? expression. Checks that all occurrences of the same [[k]] value are equal. On the first occurrence of ``` (is (?= [(same :id) (same :id)}] [1 1])) ; => true (is (?= [(same :id) (same :id)}] [1 2])) ; => false ``` | (defn same [k] (->Same k)) |
(defmethod print-dup Same [^Same this ^java.io.Writer writer] (.write writer (format "(same %s)" (pr-str (.k this))))) | |
(defmethod print-method Same [this writer] ((get-method print-dup Same) this writer)) | |
(defmethod pprint/simple-dispatch Same [^Same this] (pprint/pprint-logical-block :prefix "(same " :suffix ")" (pprint/write-out (.k this)))) | |
(methodical/defmethod =?-diff [Same :default]
[^Same this actual]
(when *same*
(if (contains? @*same* (.k this))
(let [previous-value (get @*same* (.k this))]
(when-not (= previous-value actual)
(list 'not= (symbol "#_") (list 'same (.k this)) previous-value actual)))
(do
(swap! *same* assoc (.k this) actual)
nil)))) | |
(ns mb.hawk.core (:require [clojure.java.classpath :as classpath] [clojure.java.io :as io] [clojure.pprint :as pprint] [clojure.set :as set] [clojure.string :as str] [clojure.test :as t] [clojure.tools.namespace.find :as ns.find] [eftest.report.pretty] [eftest.report.progress] [eftest.runner] [environ.core :as env] [mb.hawk.assert-exprs] [mb.hawk.hooks :as hawk.hooks] [mb.hawk.init :as hawk.init] [mb.hawk.junit :as hawk.junit] [mb.hawk.parallel :as hawk.parallel] [mb.hawk.partition :as hawk.partition] [mb.hawk.speak :as hawk.speak] [mb.hawk.util :as u])) | |
(set! *warn-on-reflection* true) | |
(comment mb.hawk.assert-exprs/keep-me) | |
Finding tests | |
Find test vars in | (defmulti find-tests
{:arglists '([arg options])}
(fn [arg _options]
(type arg))) |
collection of one of the things below | (defmethod find-tests clojure.lang.Sequential [coll options] (mapcat #(find-tests % options) coll)) |
directory name | (defmethod find-tests String [dir-name options] (find-tests (io/file dir-name) options)) |
(defn- exclude-directory? [dir exclude-directories]
(when (some (fn [directory]
(str/starts-with? (str dir) directory))
exclude-directories)
(println "Excluding directory" (pr-str (str dir)))
true)) | |
(defn- include-namespace? [ns-symbol namespace-pattern]
(if namespace-pattern
(re-matches (re-pattern namespace-pattern) (name ns-symbol))
true)) | |
directory | (defmethod find-tests java.io.File
[^java.io.File file {:keys [namespace-pattern exclude-directories], :as options}]
(when (and (.isDirectory file)
(not (str/includes? (str file) ".gitlibs/libs"))
(not (exclude-directory? file exclude-directories)))
(println "Looking for test namespaces in directory" (str file))
(->> (ns.find/find-namespaces-in-dir file)
(filter #(include-namespace? % namespace-pattern))
(mapcat #(find-tests % options))))) |
(defn- load-test-namespace [ns-symb]
(binding [hawk.init/*test-namespace-being-loaded* ns-symb]
(require ns-symb))) | |
(defn- find-tests-for-var-symbol
[symb]
(load-test-namespace (symbol (namespace symb)))
[(or (resolve symb)
(throw (ex-info (format "Unable to resolve test named %s" symb) {:test-symbol symb})))]) | |
Whether we should skip a namespace or test var because it has tags in | (defn- skip-by-tags?
[ns-or-var options]
(let [tags-set (fn [ns-or-var]
(not-empty (set (keys (meta ns-or-var)))))
excluded-tag? (when-let [exclude-tags (not-empty (set (:exclude-tags options)))]
(when-let [disallowed-tags (not-empty (set/intersection exclude-tags (tags-set ns-or-var)))]
(printf
"Skipping `%s` due to excluded tag(s): %s\n"
(if (var? ns-or-var)
(:name (meta ns-or-var))
(ns-name ns-or-var))
(->> disallowed-tags sort (str/join ",")))
true))
missing-tag? (when (var? ns-or-var)
(let [varr ns-or-var]
(when-let [only-tags (not-empty (set (:only-tags options)))]
(when-let [missing-tags (not-empty (set/difference only-tags
(tags-set (:ns (meta varr)))
(tags-set varr)))]
(printf
"Skipping `%s` due to missing only tag(s): %s\n"
(:name (meta varr))
(->> missing-tags sort (str/join ",")))
true))))]
(or excluded-tag? missing-tag?))) |
(defn- find-tests-for-namespace-symbol
[ns-symb options]
(load-test-namespace ns-symb)
(when-not (skip-by-tags? (find-ns ns-symb) options)
(remove #(skip-by-tags? % options)
(eftest.runner/find-tests ns-symb)))) | |
a test namespace or individual test | (defmethod find-tests clojure.lang.Symbol
[symb options]
(if (namespace symb)
;; a actual test var e.g. `metabase.whatever-test/my-test`
(find-tests-for-var-symbol symb)
;; a namespace e.g. `metabase.whatever-test`
(find-tests-for-namespace-symbol symb options))) |
default -- look in all dirs on the classpath | (defmethod find-tests nil [_nil options] (find-tests (classpath/system-classpath) options)) |
Find tests using the options map as passed to | (defn find-tests-with-options
[{:keys [only], :as options}]
(println "Running tests with options" (pr-str options))
(when only
(println "Running tests in" (pr-str only)))
(let [start-time-ms (System/currentTimeMillis)
tests (-> (find-tests only options)
(hawk.partition/partition-tests options))]
(printf "Finding tests took %s.\n" (u/format-milliseconds (- (System/currentTimeMillis) start-time-ms)))
(println "Running" (count tests) "tests")
tests)) |
Running tests & reporting the output | |
(defonce ^:private orig-test-var t/test-var) | |
(def ^:private ^:dynamic *parallel-test-counter* nil) | |
Run a single test | (defn run-test
[test-var]
(binding [hawk.parallel/*parallel?* (hawk.parallel/parallel? test-var)]
(some-> *parallel-test-counter* (swap! update
(if hawk.parallel/*parallel?*
:parallel
:single-threaded)
(fnil inc 0)))
(orig-test-var test-var))) |
(alter-var-root #'t/test-var (constantly run-test)) | |
Create a new test reporter/event handler, a function with the signature | (defn- reporter
[options]
(let [stdout-reporter (case (:mode options)
(:cli/ci :repl) eftest.report.pretty/report
:cli/local eftest.report.progress/report)]
(fn handle-event [event]
(hawk.junit/handle-event! event)
(hawk.speak/handle-event! event)
(stdout-reporter event)))) |
(def ^:private env-mode
(cond
(env/env :hawk-mode)
(keyword (env/env :hawk-mode))
(env/env :ci)
:cli/ci)) | |
Run To run tests from the REPL, use this function. ;; run tests in a single namespace (run (find-tests 'metabase.bad-test nil)) ;; run tests in a directory (run (find-tests "test/hawk/queryprocessortest" nil)) | (defn run-tests
([test-vars]
(run-tests test-vars nil))
([test-vars options]
(let [options (merge {:mode :repl}
options)]
(when-not (every? var? test-vars)
(throw (ex-info "Invalid test vars" {:test-vars test-vars, :options options})))
;; don't randomize test order for now please, thanks anyway
(with-redefs [eftest.runner/deterministic-shuffle (fn [_ test-vars] test-vars)]
(binding [*parallel-test-counter* (atom {})]
(merge
(eftest.runner/run-tests
test-vars
(merge
{:capture-output? false
:multithread? :vars
:report (reporter options)}
options))
@*parallel-test-counter*)))))) |
[[run-tests]] but repeat | (defn- run-tests-n-times
[test-vars options n]
(printf "Running tests %d times\n" n)
(reduce (fn [acc test-result] (merge-with
#(if (number? %2)
(+ %1 %2)
%2)
acc
test-result))
(for [i (range 1 (inc n))]
(do
(println "----------------------------")
(printf "Starting test iteration #%d\n" i)
(run-tests test-vars options))))) |
Entrypoint for the test runner. | (defn- find-and-run-tests-with-options
[options]
(let [start-time-ms (System/currentTimeMillis)
test-vars (find-tests-with-options options)
_ (hawk.hooks/before-run options)
[summary fail?] (try
(let [summary (if-let [n (get options :times)]
(run-tests-n-times test-vars options n)
(run-tests test-vars options))
fail? (pos? (+ (:error summary) (:fail summary)))]
(pprint/pprint summary)
(printf "Ran %d tests in parallel, %d single-threaded.\n"
(:parallel summary 0) (:single-threaded summary 0))
(printf "Finding and running tests took %s.\n"
(u/format-milliseconds (- (System/currentTimeMillis) start-time-ms)))
(println (if fail? "Tests failed." "All tests passed."))
[summary fail?])
(finally
(hawk.hooks/after-run options)))]
(case (:mode options)
(:cli/local :cli/ci) (System/exit (if fail? 1 0))
:repl summary))) |
REPL entrypoint. Find and run tests with options. | (defn find-and-run-tests-repl
[options]
(let [options (merge
{:mode :repl}
(when env-mode
{:mode env-mode})
options)]
(find-and-run-tests-with-options options))) |
| (defn find-and-run-tests-cli
[options]
(let [options (merge
{:mode :cli/local}
(when env-mode
{:mode env-mode})
options)]
(find-and-run-tests-with-options options))) |
(ns mb.hawk.hooks (:require [methodical.core :as methodical])) | |
Hooks to run before starting the test suite. A good place to do setup that needs to happen before running ANY tests. Add a new hook like this: (methodical/defmethod mb.hawk.hooks/before-run ::my-hook [_options] ...)
The dispatch value is not particularly important -- one hook will run for each dispatch value -- but you should
probably make it a namespaced keyword to avoid conflicts, and give it a docstring so people know why it's there. The
orders the hooks are run in is indeterminate. The docstring for [[before-run]] is updated automatically as new hooks
are added; you can check it to see which hooks are in use. Note that hooks will not be ran unless the namespace they
live in is loaded; this may be affected by Return values of methods are ignored; they are done purely for side effects. | (methodical/defmulti before-run
{:arglists '([options]), :defmethod-arities #{1}}
:none
:combo (methodical/do-method-combination)
:dispatcher (methodical/everything-dispatcher)) |
(methodical/defmethod before-run :default "Default hook for [[before-run]]; log a message about running before-run hooks." [_options] (println "Running before-run hooks...")) | |
Hooks to run after finishing the test suite, regardless of whether it passed or failed. A good place to do cleanup after finishing the test suite. Add a new hook like this: (methodical/defmethod mb.hawk.hooks/after-run ::my-hook [_options] ...)
The dispatch value is not particularly important -- one hook will run for each dispatch value -- but you should
probably make it a namespaced keyword to avoid conflicts, and give it a docstring so people know why it's there. The
orders the hooks are run in is indeterminate. The docstring for [[after-run]] is updated automatically as new hooks
are added; you can check it to see which hooks are in use. Note that hooks will not be ran unless the namespace they
live in is loaded; this may be affected by Return values of methods are ignored; they are done purely for side effects. | (methodical/defmulti after-run
{:arglists '([options]), :defmethod-arities #{1}}
:none
:combo (methodical/do-method-combination)
:dispatcher (methodical/everything-dispatcher)) |
(methodical/defmethod after-run :default "Default hook for [[after-run]]; log a message about running after-run hooks." [_options] (println "Running after-run hooks...")) | |
Code related to [[mb.hawk.core]] initialization and utils for enforcing that code isn't allowed to run while loading namespaces. | (ns mb.hawk.init (:require [clojure.pprint :as pprint])) |
Bound to the test namespace symbol that's currently getting loaded, if any. | (def ^:dynamic *test-namespace-being-loaded* nil) |
Check that we are not in the process of loading test namespaces when starting up [[mb.hawk.core]]. For example, you probably don't want to be doing stuff like creating application DB connections as a side-effect of loading test namespaces. | (defn assert-tests-are-not-initializing
[disallowed-message]
(when *test-namespace-being-loaded*
(let [e (ex-info (str (format "%s happened as a side-effect of loading namespace %s."
disallowed-message *test-namespace-being-loaded*)
" This is not allowed; make sure it's done in tests or fixtures only when running tests.")
{:namespace *test-namespace-being-loaded*})]
(pprint/pprint (Throwable->map e))
(throw e)))) |
(ns mb.hawk.junit (:require [clojure.test :as t] [mb.hawk.junit.write :as write])) | |
(defmulti ^:private handle-event!*
{:arglists '([event])}
:type) | |
Write JUnit output for a | (defn handle-event!
[{test-var :var, :as event}]
(let [test-var (or test-var
(when (seq t/*testing-vars*)
(last t/*testing-vars*)))
event (merge
{:var test-var}
event
(when test-var
{:ns (:ns (meta test-var))}))]
(try
(handle-event!* event)
(catch Throwable e
(throw (ex-info (str "Error handling event: " (ex-message e))
{:event event}
e)))))) |
for unknown event types (e.g. | (defmethod handle-event!* :default [_]) |
(defmethod handle-event!* :begin-test-run [_] (write/clean-output-dir!) (write/create-thread-pool!)) | |
(defmethod handle-event!* :summary [_] (write/wait-for-writes-to-finish)) | |
(defmethod handle-event!* :begin-test-ns
[{test-ns :ns}]
(alter-meta!
test-ns assoc ::context
{:start-time-ms (System/currentTimeMillis)
:timestamp (java.time.OffsetDateTime/now)
:test-count 0
:error-count 0
:failure-count 0
:results []})) | |
(defmethod handle-event!* :end-test-ns
[{test-ns :ns, :as event}]
(let [context (::context (meta test-ns))
result (merge
event
context
{:duration-ms (- (System/currentTimeMillis) (:start-time-ms context))})]
(write/write-ns-result! result))) | |
(defmethod handle-event!* :begin-test-var
[{test-var :var}]
(alter-meta!
test-var assoc ::context
{:start-time-ms (System/currentTimeMillis)
:assertion-count 0
:results []})) | |
(defmethod handle-event!* :end-test-var
[{test-ns :ns, test-var :var, :as event}]
(let [context (::context (meta test-var))
result (merge
event
context
{:duration-ms (- (System/currentTimeMillis) (:start-time-ms context))})]
(alter-meta! test-ns update-in [::context :results] conj result))) | |
(defn- inc-ns-test-counts! [{test-ns :ns, :as _event} & ks]
(alter-meta! test-ns update ::context (fn [context]
(reduce
(fn [context k]
(update context k inc))
context
ks)))) | |
(defn- record-assertion-result! [{test-var :var, :as event}]
(let [event (assoc event :testing-contexts (vec t/*testing-contexts*))]
(alter-meta! test-var update ::context
(fn [context]
(-> context
(update :assertion-count inc)
(update :results conj event)))))) | |
(defmethod handle-event!* :pass [event] (inc-ns-test-counts! event :test-count) (record-assertion-result! event)) | |
(defmethod handle-event!* :fail [event] (inc-ns-test-counts! event :test-count :failure-count) (record-assertion-result! event)) | |
(defmethod handle-event!* :error
[{test-var :var, :as event}]
;; some `:error` events happen because of errors in fixture initialization and don't have associated vars/namespaces
(when test-var
(inc-ns-test-counts! event :test-count :error-count)
(record-assertion-result! event))) | |
Logic related to writing test results for a namespace to a JUnit XML file. See https://stackoverflow.com/a/9410271/1198455 for the JUnit output spec. | (ns mb.hawk.junit.write (:require [clojure.java.io :as io] [clojure.pprint :as pprint] [clojure.string :as str] [pjstadig.print :as p]) (:import (java.util.concurrent Executors ThreadFactory ThreadPoolExecutor TimeUnit) (javax.xml.stream XMLOutputFactory XMLStreamWriter) (org.apache.commons.io FileUtils))) |
(def ^String ^:private output-dir "target/junit") | |
Clear any files in the output dir; create it if needed. | (defn clean-output-dir!
[]
(let [file (io/file output-dir)]
(when (and (.exists file)
(.isDirectory file))
(FileUtils/deleteDirectory file))
(.mkdirs file))) |
TODO -- not sure it makes sense to do this INSIDE OF CDATA ELEMENTS!!! | (defn- escape-unprintable-characters
[s]
(str/join (for [^char c s]
(if (and (Character/isISOControl c)
(not (Character/isWhitespace c)))
(format "&#%d;" (int c))
c)))) |
(defn- decolorize [s] (some-> s (str/replace #"\[[;\d]*m" ))) | |
Remove ANSI color escape sequences, then encode things as character entities as needed | (defn- decolorize-and-escape ^String [s] (-> s decolorize escape-unprintable-characters)) |
(defn- print-result-description [{:keys [file line message testing-contexts], :as _result}]
(println (format "%s:%d" file line))
(doseq [s (reverse testing-contexts)]
(println (str/trim (decolorize-and-escape (str s)))))
(when message
(println (decolorize-and-escape message)))) | |
(defn- print-expected [expected actual] (p/rprint "expected: ") (pprint/pprint expected) (p/rprint " actual: ") (pprint/pprint actual) (p/clear)) | |
(defn- write-result-output!
[^XMLStreamWriter w {:keys [expected actual diffs], :as result}]
(.writeCharacters w "\n")
(let [s (with-out-str
(println)
(print-result-description result)
;; this code is adapted from `pjstadig.util`
(p/with-pretty-writer
(fn []
(if (seq diffs)
(doseq [[actual [a b]] diffs]
(print-expected expected actual)
(p/rprint " diff:")
(if a
(do (p/rprint " - ")
(pprint/pprint a)
(p/rprint " + "))
(p/rprint " + "))
(when b
(pprint/pprint b))
(p/clear))
(print-expected expected actual)))))]
(.writeCData w (decolorize-and-escape s)))) | |
(defn- write-attributes! [^XMLStreamWriter w m]
(doseq [[k v] m]
(.writeAttribute w (name k) (str v)))) | |
(defn- write-element! [^XMLStreamWriter w ^String element-name attributes write-children!]
(.writeCharacters w "\n")
(.writeStartElement w element-name)
(when (seq attributes)
(write-attributes! w attributes))
(write-children!)
(.writeCharacters w "\n")
(.writeEndElement w)) | |
(defmulti ^:private write-assertion-result!*
{:arglists '([^XMLStreamWriter w result])}
(fn [_ result] (:type result))) | |
(defmethod write-assertion-result!* :pass [_ _] nil) | |
(defmethod write-assertion-result!* :fail
[w result]
(write-element!
w "failure"
nil
(fn []
(write-result-output! w result)))) | |
(defmethod write-assertion-result!* :error
[w {:keys [actual], :as result}]
(write-element!
w "error"
(when (instance? Throwable actual)
{:type (.getCanonicalName (class actual))})
(fn []
(write-result-output! w result)))) | |
(defn- write-assertion-result! [w result]
(try
(write-assertion-result!* w result)
(catch Throwable e
(throw (ex-info (str "Error writing XML for test assertion result: " (ex-message e))
{:result result}
e))))) | |
(defn- write-var-result! [^XMLStreamWriter w result]
(try
(.writeCharacters w "\n")
(write-element!
w "testcase"
{:classname (name (ns-name (:ns result)))
:name (name (symbol (:var result)))
:time (/ (:duration-ms result) 1000.0)
:assertions (:assertion-count result)}
(fn []
(doseq [result (:results result)]
(write-assertion-result! w result))))
(catch Throwable e
(throw (ex-info (str "Error writing XML for test var result: " (ex-message e))
{:result result}
e))))) | |
write one output file for each test namespace. | |
(defn- write-ns-result!*
([{test-namespace :ns, :as result}]
(let [filename (str (munge (ns-name (the-ns test-namespace))) ".xml")]
(with-open [w (.createXMLStreamWriter (XMLOutputFactory/newInstance)
(io/writer (io/file output-dir filename)
:encoding "UTF-8"))]
(.writeStartDocument w)
(write-ns-result!* w result)
(.writeEndDocument w))))
([w {test-namespace :ns, :as result}]
(try
(write-element!
w "testsuite"
{:name (name (ns-name test-namespace))
:time (/ (:duration-ms result) 1000.0)
:timestamp (str (:timestamp result))
:tests (:test-count result)
:errors (:error-count result)
:failures (:failure-count result)}
(fn []
(doseq [result (:results result)]
(write-var-result! w result))))
(catch Throwable e
(throw (ex-info (str "Error writing XML for test namespace result: " (ex-message e))
{:result result}
e)))))) | |
(defonce ^:private thread-pool (atom nil)) | |
Create a thread pool to write JUnit output with. JUnit output is written in background threads so tests are not slowed down by it. | (defn create-thread-pool!
[]
(let [[^ThreadPoolExecutor old-val] (reset-vals! thread-pool (Executors/newCachedThreadPool
(reify ThreadFactory
(newThread [_ r]
(doto (Thread. r)
(.setName "JUnit XML output writer")
(.setDaemon true))))))]
(when old-val
(.shutdown old-val)))) |
Submit a background thread task to write the JUnit output for the tests in a namespace when an | (defn write-ns-result!
[result]
(let [^Callable thunk (fn []
(write-ns-result!* result))]
(.submit ^ThreadPoolExecutor @thread-pool thunk))) |
Wait up to 10 seconds for the thread pool that writes results to finish. | (defn wait-for-writes-to-finish [] (.shutdown ^ThreadPoolExecutor @thread-pool) (.awaitTermination ^ThreadPoolExecutor @thread-pool 10 TimeUnit/SECONDS) (reset! thread-pool nil)) |
Code related to running parallel tests, and utilities for disallowing dangerous stuff inside them. | (ns mb.hawk.parallel (:require [clojure.test :as t] [eftest.runner])) |
Whether | (defn parallel?
[test-var]
(let [metta (meta test-var)]
(if-some [var-parallel (:parallel metta)]
var-parallel
(:parallel (-> metta :ns meta))))) |
(def ^:private synchronized? (complement parallel?)) | |
(alter-var-root #'eftest.runner/synchronized? (constantly synchronized?)) | |
Whether test currently being ran is being ran in parallel. | (def ^:dynamic *parallel?* nil) |
Throw an exception if we are inside a | (defn assert-test-is-not-parallel
[disallowed-message]
(when *parallel?*
(let [e (ex-info (format "%s is not allowed inside parallel tests." disallowed-message) {})]
(t/is (throw e))))) |
(ns mb.hawk.partition (:require [clojure.math :as math])) | |
Like [[clojure.core/namespace]] but handles vars. | (defn- namespace*
[x]
(cond
(instance? clojure.lang.Named x) (namespace x)
(var? x) (namespace (symbol x))
:else nil)) |
The test runner normally sorts the namespaces before running tests, so we should do the same before we partition things if we want them to make sense. Preserve the order of the vars inside each namespace. | (defn- sort-tests-by-namespace
[test-vars]
(let [test-var->sort-position (into {}
(map-indexed
(fn [i varr]
[varr i]))
test-vars)]
(sort-by (juxt namespace* test-var->sort-position)
test-vars))) |
Return a map of namespace string => number of tests in that namespace | (defn- namespace->num-tests
[test-vars]
(reduce
(fn [m test-var]
(update m (namespace* test-var) (fnil inc 0)))
{}
test-vars)) |
Return a map of test-var => ideal partition number 'Ideal partition number' is the partition it would live in ideally if we weren't worried about making sure namespaces are grouped together. | (defn- test-var->ideal-partition
[num-partitions test-vars]
(let [target-partition-size (/ (count test-vars) num-partitions)]
(into {}
(map-indexed (fn [i test-var]
(let [ideal-partition (long (math/floor (/ i target-partition-size)))]
(assert (<= 0 ideal-partition (dec num-partitions)))
[test-var ideal-partition]))
test-vars)))) |
Return a map of namespace string => set of possible partition numbers for its tests For most namespaces there should only be one possible partition but for some the ideal split happens in the middle of the namespace which means we have two possible candidate partitions to put it into. | (defn- namespace->possible-partitions
[num-partitions test-vars]
(let [test-var->ideal-partition (test-var->ideal-partition num-partitions test-vars)]
(reduce
(fn [m test-var]
(update m (namespace* test-var) #(conj (set %) (test-var->ideal-partition test-var))))
{}
test-vars))) |
Return a map of namespace string => canonical partition number for its tests If there are multiple possible candidate partitions for a namespace, choose the one that has the least tests in it. | (defn- namespace->partition
[num-partitions test-vars]
(let [namespace->num-tests (namespace->num-tests test-vars)
namespace->possible-partitions (namespace->possible-partitions num-partitions test-vars)
;; process all the namespaces that have no question about what partition they should go into first so we have as
;; accurate a picture of the size of each partition as possible before dealing with the ambiguous ones
namespaces (distinct (map namespace* test-vars))
multiple-possible-partitions? (fn [nmspace]
(> (count (namespace->possible-partitions nmspace))
1))
namespaces (concat (remove multiple-possible-partitions? namespaces)
(filter multiple-possible-partitions? namespaces))]
;; Keep track of how many tests are in each partition so far
(:namespace->partition
(reduce
(fn [m nmspace]
(let [partition (first (sort-by (fn [partition]
(get-in m [:partition->size partition]))
(namespace->possible-partitions nmspace)))]
(-> m
(update-in [:partition->size partition] (fnil + 0) (namespace->num-tests nmspace))
(assoc-in [:namespace->partition nmspace] partition))))
{}
namespaces)))) |
Return a function with the signature (f test-var) => partititon-number | (defn- make-test-var->partition
[num-partitions test-vars]
(let [namespace->partition (namespace->partition num-partitions test-vars)]
(fn test-var->partition [test-var]
(get namespace->partition (namespace* test-var))))) |
Split a sequence of partition number => sequence of tests Attempts to divide tests up into partitions that are as equal as possible, but keeps tests in the same namespace grouped together. | (defn- partition-tests-into-n-partitions
[num-partitions test-vars]
{:post [(= (count %) num-partitions)]}
(let [test-vars (sort-tests-by-namespace test-vars)
test-var->partition (make-test-var->partition num-partitions test-vars)]
(reduce
(fn [m test-var]
(update m (test-var->partition test-var) #(conj (vec %) test-var)))
(sorted-map)
test-vars))) |
(defn- validate-partition-options [tests {num-partitions :partition/total, partition-index :partition/index, :as _options}]
(assert (and num-partitions partition-index)
":partition/total and :partition/index must be set together")
(assert (pos-int? num-partitions)
"Invalid :partition/total - must be a positive integer")
(assert (<= num-partitions (count tests))
"Invalid :partition/total - cannot have more partitions than number of tests")
(assert (int? partition-index)
"Invalid :partition/index - must be an integer")
(assert (<= 0 partition-index (dec num-partitions))
(format "Invalid :partition/index - must be between 0 and %d" (dec num-partitions)))) | |
Return only | (defn partition-tests
[tests {num-partitions :partition/total, partition-index :partition/index, :as options}]
(if (or num-partitions partition-index)
(do
(validate-partition-options tests options)
(let [partition-index->tests (partition-tests-into-n-partitions num-partitions tests)
partition (get partition-index->tests partition-index)]
(printf "Running tests in partition %d of %d (%d tests of %d)...\n"
(inc partition-index)
num-partitions
(count partition)
(count tests))
partition))
tests)) |
(ns mb.hawk.speak (:require [clojure.java.shell :as sh])) | |
Handles a test event by speaking(!?) it if appropriate | (defmulti handle-event! :type) |
(defn- enabled? [] (some? (System/getenv "SPEAK_TEST_RESULTS"))) | |
(defmethod handle-event! :default [_] nil) | |
(defmethod handle-event! :summary
[{:keys [error fail]}]
(when (enabled?)
(apply sh/sh "say"
(if (zero? (+ error fail))
"all tests passed"
"tests failed")
(for [[n s] [[error "error"]
[fail "failure"]]
:when (pos? n)]
(str n " " s (when (< 1 n) "s")))))) | |
(ns mb.hawk.util) | |
Format a time interval in nanoseconds to something more readable. (µs/ms/etc.) | (defn format-nanoseconds
^String [nanoseconds]
;; The basic idea is to take `n` and see if it's greater than the divisior. If it is, we'll print it out as that
;; unit. If more, we'll divide by the divisor and recur, trying each successively larger unit in turn. e.g.
;;
;; (format-nanoseconds 500) ; -> "500 ns"
;; (format-nanoseconds 500000) ; -> "500 µs"
(loop [n nanoseconds, [[unit divisor] & more] [[:ns 1000]
[:µs 1000]
[:ms 1000]
[:s 60]
[:mins 60]
[:hours 24]
[:days 7]
[:weeks (/ 365.25 7)]
[:years Double/POSITIVE_INFINITY]]]
(if (and (> n divisor)
(seq more))
(recur (/ n divisor) more)
(format "%.1f %s" (double n) (name unit))))) |
Format a time interval in microseconds into something more readable. | (defn format-microseconds ^String [microseconds] (format-nanoseconds (* 1000.0 microseconds))) |
Format a time interval in milliseconds into something more readable. | (defn format-milliseconds ^String [milliseconds] (format-microseconds (* 1000.0 milliseconds))) |