-
Notifications
You must be signed in to change notification settings - Fork 20
/
test.clj
168 lines (144 loc) · 5.69 KB
/
test.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
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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
(ns clj-chrome-devtools.cljs.test
"Build a ClojureScript build and run its tests as a clojure
test. This can hook your cljs app tests into the normal
clojure testing run."
(:require [cljs.build.api :as cljs-build]
[clojure.java.io :as io]
[clj-chrome-devtools.automation.fixture :refer [create-chrome-fixture]]
[clj-chrome-devtools.automation :as automation]
[clj-chrome-devtools.impl.util :refer [random-free-port]]
[org.httpkit.server :as http-server]
[clojure.string :as str]
[clojure.test])
(:import (java.io File)))
(defn- find-defproject [file]
(with-open [in (java.io.PushbackReader. (io/reader file))]
(loop [form (read in false ::eof)]
(cond
(= ::eof form)
(throw (ex-info "Can't find defproject form" {:file file}))
(and (coll? form) (= (first form) 'defproject))
form
:else
(recur (read in))))))
(defn- load-project-clj
"Load project.clj file and turn it into a map."
[]
(->> "project.clj" find-defproject
(drop 3) ;; remove defproject, name and version
(partition 2) ;; take top level :key val pairs
(map vec)
(into {})))
(defn- build-by-id [project-clj build-id]
(->> project-clj :cljsbuild :builds
(some #(when (= build-id (:id %))
%))))
(defn- test-runner-forms
"ClojureScript forms for test runner"
[namespaces]
(str
"(ns clj-chrome-devtools-runner
(:require [cljs.test :refer [run-tests]]
" (str/join "\n" namespaces) "))\n"
"(def PRINTED (atom []))\n"
"(defn get-printed [] "
" (let [v @PRINTED] "
" (reset! PRINTED []) "
" (clj->js v)))\n"
"(defn run-chrome-tests []"
" (set! *print-fn* (fn [& msg] (swap! PRINTED conj (apply str msg))))\n"
" (run-tests " (str/join "\n"
(map #(str "'" %) namespaces)) "))"))
(defn- with-test-runner-source [namespaces source-path fun]
;; Create a test runner source file in the given source path
;; We have to put this in an existing source path as
;; we can't add a new source path dynamically (files therein
;; won't be found with io/resource). It is simpler to add
;; it to an existing source path and remove afterwards.
(let [runner (io/file source-path
"clj_chrome_devtools_runner.cljs")]
(spit runner (test-runner-forms namespaces))
(try
(fun)
(finally
(io/delete-file runner)))))
(defn build [project-clj build-id test-runner-namespaces]
(let [{:keys [source-paths compiler] :as build}
(build-by-id project-clj build-id)]
(with-test-runner-source test-runner-namespaces (last source-paths)
#(cljs-build/build
(cljs-build/inputs source-paths)
(assoc compiler
:main "clj-chrome-devtools-runner"
:warnings {:single-segment-namespace false})))
(assert (.exists (io/file (:output-to compiler)))
"build output file exists")
{:js (:output-to compiler)
:js-directory (:output-dir compiler)}))
(defn- test-page [js]
(str "<html>"
" <head>"
" </head>"
" <body onload=\"clj_chrome_devtools_runner.run_chrome_tests();\">"
" <script type=\"text/javascript\" src=\"" js "\">"
" </script>"
" </body>"
"</html>"))
(defn- file-handler [{:keys [uri request-method] :as req}]
(let [file (io/file "." (subs uri 1))]
(if (and (= request-method :get) (.canRead file))
(do
{:status 200
:headers {"Content-Type" (cond
(str/ends-with? uri ".html")
"text/html"
(str/ends-with? uri ".js")
"application/javascript"
:default
"application/octet-stream")}
:body (slurp file)})
{:status 404})))
(def ^{:doc "cljs.test failure/error report regex"
:private true}
final-test-report-pattern #"(\d+) failures, (\d+) errors.")
(defn- assert-test-result [msg]
(let [[match errors failures] (re-matches final-test-report-pattern msg)]
(when match
(assert (= "0" errors failures)
"ClojureScript tests had failures or errors, see previous output for details.")
true)))
(defn- read-console-log-messages []
(loop []
(let [msgs (automation/evaluate "clj_chrome_devtools_runner.get_printed()")]
(doseq [m (mapcat #(str/split % #"\n") msgs)]
(println "[CLJS]" m))
(when-not (some assert-test-result msgs)
(Thread/sleep 100)
(recur)))))
(defn run-tests
([build-output]
(run-tests build-output nil))
([{:keys [js js-directory]} {:keys [no-sandbox?]}]
(let [chrome-fixture (create-chrome-fixture {:headless? true :no-sandbox? no-sandbox?})]
(chrome-fixture
(fn []
(let [con (.-connection @automation/current-automation)
port (random-free-port)
server (http-server/run-server file-handler {:port port})
dir (io/file ".")
f (File/createTempFile "test" ".html"
(io/file "."))]
(try
(spit f (test-page js))
(automation/to (str "http://localhost:" port "/" (.getName f)))
(read-console-log-messages)
(server)
(finally
(io/delete-file f)))))))))
(defn build-and-test
([build-id namespaces]
(build-and-test build-id namespaces nil))
([build-id namespaces options]
(let [project-clj (load-project-clj)
build-output (build project-clj build-id namespaces)]
(run-tests build-output options))))