Skip to content

Commit 106e5de

Browse files
mitch-kylemitch-kyle
committed
test runner for basilisp.test basilisp-lang#980 
1 parent ae617c7 commit 106e5de

File tree

10 files changed

+1272
-145
lines changed

10 files changed

+1272
-145
lines changed

‎CHANGELOG.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
88
### Added
99
* Added the `-p`/`--include-path` CLI command to prepend entries to the `sys.path` as an alternative to `PYTHONPATH` (#1027)
1010
* Added an empty entry to `sys.path` for all CLI entrypoints (`basilisp run`, `basilisp repl`, etc.) (#1027)
11+
* Added test runner to `basilisp.test` #980
12+
* Added test ops to nrepl #980
1113

1214
### Changed
1315
* The compiler will no longer require `Var` indirection for top-level `do` forms unless those forms specify `^:use-var-indirection` metadata (which currently is only used in the `ns` macro) (#1034)

‎src/basilisp/contrib/nrepl_server.lpy

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@
33
(ns basilisp.contrib.nrepl-server
44
"A port of `nbb <https://github.com/babashka/nbb>`_ 's nREPL server implementation to Basilisp."
55
(:require [basilisp.contrib.bencode :as bc]
6-
[basilisp.string :as str])
6+
[basilisp.string :as str]
7+
[basilisp.contrib.nrepl-server.test :as test])
78
(:import basilisp.logconfig
89
logging
910
socketserver
@@ -330,7 +331,9 @@
330331
:complete handle-complete
331332
;; :macroexpand handle-macroexpand
332333
;; :classpath handle-classpath
333-
})
334+
:test test/handle-test
335+
:test-all test/handle-test-all
336+
:retest test/handle-retest})
334337

335338
(defn- handle-request [{:keys [op] :as request} send-fn]
336339
(if-let [op-fn (get ops op)]

‎src/basilisp/contrib/nrepl_server/test.lpy

Lines changed: 190 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,190 @@
1+
(ns basilisp.contrib.nrepl-server.test
2+
(:import time)
3+
(:require [basilisp.stacktrace :refer [print-stack-trace]]
4+
[basilisp.test :as test]
5+
[basilisp.set :as set]))
6+
7+
(defonce current-report
8+
(atom nil))
9+
10+
(defn- now
11+
[]
12+
(time/time))
13+
14+
(defrecord Report [fail-fast? failed? tests namespaces start end]
15+
test/Report
16+
17+
(continue? [self]
18+
(not (and fail-fast? failed?)))
19+
20+
(report-begin [self]
21+
(assoc-in self [:start nil] (now)))
22+
(report-end [self]
23+
(assoc-in self [:end nil] (now)))
24+
25+
(report-namespace-begin [self ns]
26+
(assoc-in self [:start ns] (now)))
27+
(report-namespace-end [self ns assertions]
28+
(-> self
29+
(assoc :failed? (boolean (or failed? (test/failures assertions))))
30+
(assoc-in [:namespaces ns] assertions)
31+
(assoc-in [:end ns] (now))))
32+
33+
(report-test-begin [self test-var]
34+
(assoc-in self [:start test-var] (now)))
35+
(report-test-end [self test-var assertions]
36+
(-> self
37+
(assoc :failed? (boolean (or failed? (test/failures assertions))))
38+
(assoc-in [:tests test-var] assertions)
39+
(assoc-in [:end test-var] (now)))))
40+
41+
(defn- make-result
42+
[assertions]
43+
(vec
44+
(map-indexed (fn [i {:as assertion
45+
:keys [ns var test-section message type
46+
actual expected expr line]}]
47+
(let [error? (= type :error)
48+
fail? (#{:error :failure} type)
49+
file (-> var meta :file)]
50+
(cond-> {:index i
51+
:context test-section
52+
:message message
53+
:type (case type
54+
:failure "fail"
55+
(name type))
56+
:var (if var (-> var name str) "unknown")
57+
:ns (if ns (name ns) "unknown")}
58+
error? (assoc :fault "true"
59+
:error
60+
(when (instance? BaseException
61+
actual)
62+
(with-out-str
63+
(print-stack-trace actual))))
64+
(and line fail?) (assoc :line line)
65+
(and file fail?) (assoc :file file)
66+
expr (assoc :expr (pr-str expr))
67+
fail? (assoc :actual (str (pr-str actual)
68+
\newline)
69+
:expected (str (pr-str expected)
70+
\newline))
71+
:always (update-keys name))))
72+
assertions)))
73+
74+
(defn- make-elapsed-time
75+
[start end]
76+
(let [ms (python/int (* (- end start) 1000))]
77+
{"ms" ms
78+
"humanized" (format "Completed in %d ms" ms)}))
79+
80+
(defn- var-path
81+
[var]
82+
[(-> var namespace name) (-> var name str)])
83+
84+
(defn- make-response
85+
[{:as report :keys [tests namespaces start end]}]
86+
(let [elapsed-time #(make-elapsed-time (get start %) (get end %))]
87+
{"testing-ns" (str (or (some-> namespaces first key)
88+
(some-> tests first key namespace)))
89+
"results" (->> (update-keys namespaces
90+
#(symbol (str %) "unknown"))
91+
(filter (comp test/failures val))
92+
(concat tests)
93+
(map (juxt (comp var-path key)
94+
(comp make-result val)))
95+
(reduce #(apply assoc-in %1 %2) {}))
96+
"summary" (-> (reduce (let [+count (fnil + 0)]
97+
(fn [summary [k assertions]]
98+
(->> assertions
99+
(map :type)
100+
frequencies
101+
(merge-with +count summary))))
102+
(zipmap [:pass :failure :error]
103+
(repeat 0))
104+
(concat tests namespaces))
105+
(set/rename-keys {:failure :fail})
106+
(assoc :ns (count namespaces)
107+
:var (count tests)
108+
:test (->> (vals tests)
109+
(concat (vals namespaces))
110+
(transduce (map count) +)))
111+
(update-keys name))
112+
"var-elapsed-time" (reduce (fn [acc v]
113+
(assoc-in acc
114+
(var-path v)
115+
{"elapsed-time" (elapsed-time v)}))
116+
{}
117+
(keys tests))
118+
"ns-elapsed-time" (into {}
119+
(map (juxt name elapsed-time))
120+
(keys namespaces))
121+
"elapsed-time" (elapsed-time nil)}))
122+
123+
(defn- make-report!
124+
[request vars]
125+
(let [{:keys [fail-fast
126+
include
127+
exclude]} request
128+
include? (if (seq include)
129+
(apply some-fn (map keyword include))
130+
(constantly true))
131+
exclude? (if (seq exclude)
132+
(apply some-fn (map keyword exclude))
133+
(constantly false))]
134+
(->> vars
135+
(filter (comp (every-pred ::test/test include? (complement exclude?))
136+
meta))
137+
(test/compile-report (map->Report {:fail-fast? (= fail-fast "true")}))
138+
(reset! current-report))))
139+
140+
(defmacro ^:private print-errors
141+
[& body]
142+
`(try
143+
~@body
144+
(catch python/Exception ~'e
145+
(print-stack-trace ~'e)
146+
(throw ~'e))))
147+
148+
(defn handle-test
149+
"Handle \"test\" nrepl command. Run specified tests or all tests in
150+
specified namespace. Tests must be loaded."
151+
[request send-fn]
152+
(print-errors
153+
(let [{:keys [ns tests]} request]
154+
(->> (if (seq tests)
155+
(keep (comp resolve (partial symbol ns)) tests)
156+
(some-> ns symbol find-ns ns-publics vals))
157+
(make-report! request)
158+
make-response
159+
(send-fn request)))))
160+
161+
(defn handle-test-all
162+
"Handle \"test-all\" nrepl command. Run all tests in all loaded
163+
namespaces. Unable to load additional namespaces."
164+
[request send-fn]
165+
(print-errors
166+
(->> (all-ns)
167+
(mapcat (comp vals ns-publics))
168+
(make-report! request)
169+
make-response
170+
(send-fn request))))
171+
172+
(defn- failing-tests
173+
[{:as report
174+
:keys [tests namespaces]}]
175+
(let [ns-fail? (comp (memoize #(test/failures (get namespaces %)))
176+
namespace)]
177+
(keep (fn [[test-var assertions]]
178+
(when (or (ns-fail? test-var)
179+
(test/failures assertions))
180+
test-var))
181+
tests)))
182+
183+
(defn handle-retest
184+
"Handle \"retest\" nrepl command. Re-run any previously failing tests."
185+
[request send-fn]
186+
(print-errors
187+
(->> (failing-tests @current-report)
188+
(make-report! request)
189+
make-response
190+
(send-fn request))))

0 commit comments

Comments
 (0)