Port cljs.test to Planck

This essentially involves a port of its macros to be able to work in bootstrap.

planck-cljs/script/build.clj

@@ -24,7 +24,7 @@
          (binding [*out* *err*]
            (println "WARNING:" (cljs.analyzer/message env s)))
          (System/exit 1))))]
-  (api/build (api/inputs "src" "test")                      ;; For now, pre-compile tests
+  (api/build (api/inputs "src")
     {:output-dir         "out"
      :output-to          "out/main.js"
      :optimizations      :none
@@ -76,16 +76,10 @@
 (extract-analysis-cache "out/planck/io.cljs.cache.edn" "out/planck/io.cljs.cache.json")
 (extract-analysis-cache "out/planck/shell.cljs.cache.edn" "out/planck/shell.cljs.cache.json")
 (extract-analysis-cache "out/planck/from/io/aviso/ansi.cljs.cache.edn" "out/planck/from/io/aviso/ansi.cljs.cache.json")
+(extract-analysis-cache "out/planck/test/ana_api.cljs.cache.edn" "out/planck/test/ana_api.cljs.cache.json")
+(extract-analysis-cache "out/planck/test/template.cljs.cache.edn" "out/planck/test/template.cljs.cache.json")
 
 (extract-analysis-cache "out/tailrecursion/cljson.cljs.cache.edn" "out/tailrecursion/cljson.cljs.cache.json")
 
-
-;; For now, use pre-compiled tests
-(extract-analysis-cache "out/planck/test_runner.cljs.cache.edn" "out/planck/test_runner.cljs.cache.json")
-(extract-analysis-cache "out/planck/core_test.cljs.cache.edn" "out/planck/core_test.cljs.cache.json")
-(extract-analysis-cache "out/planck/io_test.cljs.cache.edn" "out/planck/io_test.cljs.cache.json")
-(extract-analysis-cache "out/planck/shell_test.cljs.cache.edn" "out/planck/shell_test.cljs.cache.json")
-(extract-analysis-cache "out/planck/repl_test.cljs.cache.edn" "out/planck/repl_test.cljs.cache.json")
-
 (println "Done building")
 (System/exit 0)

planck-cljs/script/bundle

@@ -4,6 +4,8 @@
 set -e
 set -o pipefail
 
+cp src-bundle/cljs/test.clj out/cljs
+cp src/planck/test/macros.clj out/planck/test
 cp src/planck/{repl,core,shell}.clj out/planck
 cp src/planck/from/io/aviso/ansi.clj out/planck/from/io/aviso
 

planck-cljs/src-bundle/cljs/test.clj

@@ -0,0 +1,254 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns cljs.test
+  (:require-macros [planck.test.macros])
+  (:require [cljs.env :as env]
+            [cljs.analyzer :as ana]
+            [planck.test.ana-api :as ana-api]
+            [planck.test.template]
+            [planck.core]))
+
+;; =============================================================================
+;; Assertion Macros
+
+(defmacro is
+  "Generic assertion macro.  'form' is any predicate test.
+  'msg' is an optional message to attach to the assertion.
+
+  Example: (is (= 4 (+ 2 2)) \"Two plus two should be 4\")
+  Special forms:
+  (is (thrown? c body)) checks that an instance of c is thrown from
+  body, fails if not; then returns the thing thrown.
+  (is (thrown-with-msg? c re body)) checks that an instance of c is
+  thrown AND that the message on the exception matches (with
+  re-find) the regular expression re."
+  ([form] `(cljs.test/is ~form nil))
+  ([form msg]
+   `(planck.test.macros/try-expr ~msg ~form)))
+
+(defmacro are
+  "Checks multiple assertions with a template expression.
+  See clojure.template/do-template for an explanation of
+  templates.
+  Example: (are [x y] (= x y)
+                2 (+ 1 1)
+                4 (* 2 2))
+  Expands to:
+           (do (is (= 2 (+ 1 1)))
+               (is (= 4 (* 2 2))))
+  Note: This breaks some reporting features, such as line numbers."
+  [argv expr & args]
+  (if (or
+        ;; (are [] true) is meaningless but ok
+        (and (empty? argv) (empty? args))
+        ;; Catch wrong number of args
+        (and (pos? (count argv))
+          (pos? (count args))
+          (zero? (mod (count args) (count argv)))))
+    `(planck.test.macros/do-template ~argv (is ~expr) ~@args)
+    (throw (ex-info "The number of args doesn't match are's argv." {}))))
+
+(defmacro testing
+  "Adds a new string to the list of testing contexts.  May be nested,
+  but must occur inside a test function (deftest)."
+  ([string & body]
+   `(do
+      (cljs.test/update-current-env! [:testing-contexts] conj ~string)
+      (try
+        ~@body
+        (finally
+          (cljs.test/update-current-env! [:testing-contexts] rest))))))
+
+;; =============================================================================
+;; Defining Tests
+
+(defonce vars (atom {}))
+(defonce counter (atom 0))
+
+(defmacro deftest
+  "Defines a test function with no arguments.  Test functions may call
+  other tests, so tests may be composed.  If you compose tests, you
+  should also define a function named test-ns-hook; run-tests will
+  call test-ns-hook instead of testing all vars.
+  Note: Actually, the test body goes in the :test metadata on the var,
+  and the real function (the value of the var) calls test-var on
+  itself.
+  When cljs.analyzer/*load-tests* is false, deftest is ignored."
+  [name & body]
+  (when ana/*load-tests*
+    (let [id (swap! counter inc)]
+      `(do
+         (def ~(vary-meta name assoc :test `(fn [] ~@body))
+           (fn [] (cljs.test/test-var (@cljs.test$macros/vars ~id))))
+         (swap! vars assoc ~id (planck.core/eval ~(list 'var name)))
+         nil))))
+
+(defmacro async
+  "Wraps body as a CPS function that can be returned from a test to
+  continue asynchronously.  Binds done to a function that must be
+  invoked once and from an async context after any assertions.
+  (deftest example-with-timeout
+    (async done
+      (js/setTimeout (fn []
+                       ;; make assertions in async context...
+                       (done) ;; ...then call done
+                       )
+                     0)))"
+  [done & body]
+  `(reify
+     cljs.test/IAsyncTest
+     cljs.core/IFn
+     (~'-invoke [_# ~done]
+       ~@body)))
+
+;; =============================================================================
+;; Running Tests
+
+(defn ns? [x]
+  (and (seq? x) (= (first x) 'quote)))
+
+(defmacro run-tests-block
+  "Like test-vars, but returns a block for further composition and
+  later execution."
+  [env-or-ns & namespaces]
+  (assert (every?
+            (fn [[quote ns]] (and (= quote 'quote) (symbol? ns)))
+            namespaces)
+    "All arguments to run-tests must be quoted symbols")
+  (let [is-ns (ns? env-or-ns)
+        env (gensym "env")
+        summary (gensym "summary")]
+    `(let [~env ~(if is-ns
+                   `(cljs.test/empty-env)
+                   env-or-ns)
+           ~summary (cljs.core/volatile!
+                      {:test 0 :pass 0 :fail 0 :error 0
+                       :type :summary})]
+       (concat ~@(map
+                   (fn [ns]
+                     `(concat (cljs.test/test-ns-block ~env ~ns)
+                        [(fn []
+                           (cljs.core/vswap!
+                             ~summary
+                             (partial merge-with +)
+                             (:report-counters
+                               (cljs.test/get-and-clear-env!))))]))
+                   (if is-ns
+                     (concat [env-or-ns] namespaces)
+                     namespaces))
+         [(fn []
+            (cljs.test/set-env! ~env)
+            (cljs.test/do-report (deref ~summary))
+            (cljs.test/report (assoc (deref ~summary) :type :end-run-tests))
+            (cljs.test/clear-env!))]))))
+
+(defmacro run-tests
+  "Runs all tests in the given namespaces; prints results.
+  Defaults to current namespace if none given. Does not return a meaningful
+  value due to the possiblity of asynchronous execution. To detect test
+  completion add a :end-run-tests method case to the cljs.test/report
+  multimethod."
+  ([] `(run-tests (cljs.test/empty-env) '~ana/*cljs-ns*))
+  ([env-or-ns]
+   (if (ns? env-or-ns)
+     `(run-tests (cljs.test/empty-env) ~env-or-ns)
+     `(run-tests ~env-or-ns '~ana/*cljs-ns*)))
+  ([env-or-ns & namespaces]
+   `(cljs.test/run-block (run-tests-block ~env-or-ns ~@namespaces))))
+
+(defmacro run-all-tests
+  "Runs all tests in all namespaces; prints results.
+  Optional argument is a regular expression; only namespaces with
+  names matching the regular expression (with re-matches) will be
+  tested."
+  ([] `(cljs.test/run-all-tests nil (cljs.test/empty-env)))
+  ([re] `(cljs.test/run-all-tests ~re (cljs.test/empty-env)))
+  ([re env]
+   `(cljs.test/run-tests ~env
+      ~@(map
+          (fn [ns] `(quote ~ns))
+          (cond->> (ana-api/all-ns)
+            re (filter #(re-matches re (name %))))))))
+
+(defmacro test-all-vars-block
+  ([[quote ns]]
+   `(let [env# (cljs.test/get-current-env)]
+      (concat
+        [(fn []
+           (when (nil? env#)
+             (cljs.test/set-env! (cljs.test/empty-env)))
+           ~(when (ana-api/ns-resolve ns 'cljs-test-once-fixtures)
+              `(cljs.test/update-current-env! [:once-fixtures] assoc '~ns
+                 ~(symbol (name ns) "cljs-test-once-fixtures")))
+           ~(when (ana-api/ns-resolve ns 'cljs-test-each-fixtures)
+              `(cljs.test/update-current-env! [:each-fixtures] assoc '~ns
+                 ~(symbol (name ns) "cljs-test-each-fixtures"))))]
+        (cljs.test/test-vars-block
+          [~@(->> (ana-api/ns-interns ns)
+               (filter (fn [[_ v]] (:test v)))
+               (sort-by (fn [[_ v]] (:line v)))
+               (map (fn [[k _]]
+                      `(planck.core/eval ~(list 'var (symbol (name ns) (name k)))))))])
+        [(fn []
+           (when (nil? env#)
+             (cljs.test/clear-env!)))]))))
+
+(defmacro test-all-vars
+  "Calls test-vars on every var with :test metadata interned in the
+  namespace, with fixtures."
+  [[quote ns :as form]]
+  `(cljs.test/run-block
+     (concat (test-all-vars-block ~form)
+       [(fn []
+          (cljs.test/report {:type :end-test-all-vars :ns ~form}))])))
+
+(defmacro test-ns-block
+  "Like test-ns, but returns a block for further composition and
+  later execution.  Does not clear the current env."
+  ([env [quote ns :as form]]
+   (assert (and (= quote 'quote) (symbol? ns)) "Argument to test-ns must be a quoted symbol")
+   (assert (ana-api/find-ns ns) (str "Namespace " ns " does not exist"))
+   `[(fn []
+       (cljs.test/set-env! ~env)
+       (cljs.test/do-report {:type :begin-test-ns, :ns ~form})
+       ;; If the namespace has a test-ns-hook function, call that:
+       ~(if-let [v (ana-api/ns-resolve ns 'test-ns-hook)]
+          `(~(symbol (name ns) "test-ns-hook"))
+          ;; Otherwise, just test every var in the namespace.
+          `(cljs.test/block (cljs.test/test-all-vars-block ~form))))
+     (fn []
+       (cljs.test/do-report {:type :end-test-ns, :ns ~form}))]))
+
+(defmacro test-ns
+  "If the namespace defines a function named test-ns-hook, calls that.
+  Otherwise, calls test-all-vars on the namespace.  'ns' is a
+  namespace object or a symbol.
+  Internally binds *report-counters* to a ref initialized to
+  *initial-report-counters*.  "
+  ([ns] `(cljs.test/test-ns (cljs.test/empty-env) ~ns))
+  ([env [quote ns :as form]]
+   `(cljs.test/run-block
+      (concat (cljs.test/test-ns-block ~env ~form)
+        [(fn []
+           (cljs.test/clear-env!))]))))
+
+;; =============================================================================
+;; Fixes
+
+(defmacro use-fixtures [type & fns]
+  (condp = type
+    :once
+    `(def ~'cljs-test-once-fixtures
+       [~@fns])
+    :each
+    `(def ~'cljs-test-each-fixtures
+       [~@fns])
+    :else
+    (throw
+      (ex-info "First argument to cljs.test/use-fixtures must be :once or :each" {}))))

planck-cljs/src/planck/repl.cljs

@@ -615,7 +615,6 @@
       (and (= name 'cljs.repl) macros)
       (and (= name 'cljs.js) macros)
       (and (= name 'cljs.pprint) macros)
-      (and (= name 'cljs.test) macros)
       (and (= name 'clojure.template) macros)
       (and (= name 'tailrecursion.cljson) macros)
       (and (= name 'lazy-map.core) macros)))

planck-cljs/src/planck/test/ana_api.cljs

@@ -0,0 +1,52 @@
+(ns planck.test.ana-api
+  (:refer-clojure :exclude [find-ns ns-interns])
+  (:require [cljs.env :as env]
+            [cljs.analyzer :as ana]))
+
+(defn resolve
+  "Given an analysis environment resolve a var. Analogous to
+   clojure.core/resolve"
+  [env sym]
+  {:pre [(map? env) (symbol? sym)]}
+  (try
+    (ana/resolve-var env sym
+      (ana/confirm-var-exists-throw))
+    (catch :default e
+      (ana/resolve-macro-var env sym))))
+
+(defn all-ns
+  "Return all namespaces. Analagous to clojure.core/all-ns but
+  returns symbols identifying namespaces not Namespace instances."
+  ([]
+   (all-ns env/*compiler*))
+  ([state]
+   (keys (get @state :cljs.analyzer/namespaces))))
+
+(defn find-ns
+  "Given a namespace return the corresponding namespace analysis map. Analagous
+  to clojure.core/find-ns."
+  ([sym]
+   (find-ns env/*compiler* sym))
+  ([state sym]
+   {:pre [(symbol? sym)]}
+   (get-in @state [:cljs.analyzer/namespaces sym])))
+
+(defn ns-interns
+  "Given a namespace return all the var analysis maps. Analagous to
+  clojure.core/ns-interns but returns var analysis maps not vars."
+  ([ns]
+   (ns-interns env/*compiler* ns))
+  ([state ns]
+   {:pre [(symbol? ns)]}
+   (merge
+     (get-in @state [:cljs.analyzer/namespaces ns :macros])
+     (get-in @state [:cljs.analyzer/namespaces ns :defs]))))
+
+(defn ns-resolve
+  "Given a namespace and a symbol return the corresponding var analysis map.
+  Analagous to clojure.core/ns-resolve but returns var analysis map not Var."
+  ([ns sym]
+   (ns-resolve env/*compiler* ns sym))
+  ([state ns sym]
+   {:pre [(symbol? ns) (symbol? sym)]}
+   (get-in @state [:cljs.analyzer/namespaces ns :defs sym])))