diff --git a/docs/guide/clojure-compatibility.md b/docs/guide/clojure-compatibility.md index b76b9ad0e..b3e82d28e 100644 --- a/docs/guide/clojure-compatibility.md +++ b/docs/guide/clojure-compatibility.md @@ -24,7 +24,7 @@ with no known failures, compile skips, panic skips, or runtime skips. | `clojure.edn` | `read`, `read-string` | | `clojure.pprint` | `pprint`, `cl-format` (aesthetic/radix/iteration/conditional/justify directives), `print-table` | | `clojure.repl` | `dir`, `apropos`, `doc`, `find-doc`, `source` | -| `clojure.test` | `deftest`, `is`, `testing`, `are`, fixtures | +| `clojure.test` | `deftest`, `is`, `testing`, `are`, fixtures, `run-tests`, `run-test-var`/`run-test` (single var) | | `clojure.core.async` | channels, `go`/`go-loop`, `alts!`, `mult`/`pub`, `pipe`/`merge`/`split` (real goroutines, not IOC) | | `io` | polymorphic readers/writers, `slurp`/`spit`, lazy line-seq, encoding, URLs, `with-open`, `resource` (filesystem in dev, embedded in `-b` binaries) | | `http` | Ring-style server + client, streaming responses | diff --git a/docs/testing-and-conformance.md b/docs/testing-and-conformance.md index bfa8698b4..c3b47ef71 100644 --- a/docs/testing-and-conformance.md +++ b/docs/testing-and-conformance.md @@ -21,7 +21,7 @@ This document defines how we test let-go: unit/integration/perf tests, a `clojur ### Test framework (user-facing) - `clojure.test`-compatible API (subset): - - Macros/functions: `deftest`, `testing`, `is`, `are`, `use-fixtures` (once/each), `run-tests`. + - Macros/functions: `deftest`, `testing`, `is`, `are`, `use-fixtures` (once/each), `run-tests`, `run-test-var`/`run-test` for a single var (same fixtures, same namespace switch — what editors call to run the test under the cursor). - Output formats: human-readable default; optional TAP and JUnit XML for CI. - Selectors: include/exclude by ns or metadata; `:only`, `:focus`, `:skip`. - CLI: `lg test` supports: diff --git a/pkg/rt/core/test.lg b/pkg/rt/core/test.lg index 735f7f0d0..284253f86 100644 --- a/pkg/rt/core/test.lg +++ b/pkg/rt/core/test.lg @@ -29,6 +29,12 @@ (let [ret# (do ~@body)] (set! *testing-vars* (pop *testing-vars*)) ret#))) + ;; The same keys Clojure puts on a test var, attached at evaluation + ;; time so :ns is the namespace the test was defined in. run-test-var + ;; reads :ns to run a single test inside its own namespace, and :test + ;; holds the test fn itself — as in clojure.test, where the runner + ;; invokes (:test (meta v)). + (alter-meta! (var ~name) assoc :ns *ns* :name '~name :test ~name) (register-test! (var ~name)))) (defmacro is @@ -55,48 +61,100 @@ (println "FAIL" '~form "-" ~msg) false)))) +(defn compose-fixtures + "Compose two fixture fns into one that wraps f around g around the test fn." + [f g] + (fn [t] (f (fn [] (g t))))) + +(defn default-fixture + "Fixture that adds nothing: it just calls the test fn." + [t] + (t)) + +(defn join-fixtures + "Compose a collection of fixture fns into a single fixture fn." + [fs] + (reduce compose-fixtures default-fixture fs)) + +(defn- test-var* + "Run one test var inside *each-fixtures*, counting a thrown body as an + :error instead of letting it escape. Shared by run-tests and + run-test-var so a single-var run and a whole-suite run cannot drift. + Runs the fn in the var's :test metadata, as clojure.test does, and + falls back to the var's value for a plain fn var." + [tv] + (set! *testing-contexts* []) + (try + (let [test-fn (or (:test (meta tv)) (deref tv))] + ((join-fixtures *each-fixtures*) (fn [] (test-fn)))) + (catch e + (set! *testing-contexts* []) + (set! *report-counters* (update *report-counters* :error inc)) + (set! *test-result* false) + (println "ERROR in test:" e)))) + (defn run-tests [& nss] (set! *report-counters* {:test 0 :pass 0 :fail 0 :error 0}) (set! *test-result* true) (println "Running tests...") - (let [compose-fixtures (fn [f g] (fn [t] (f (fn [] (g t))))) - default-fixture (fn [t] (t)) - join-fixtures (fn [fs] (reduce compose-fixtures default-fixture fs)) - runner (fn [tv] - (set! *testing-contexts* []) - (try - (let [test-fn (deref tv)] - ((join-fixtures *each-fixtures*) (fn [] (test-fn)))) - (catch e - (set! *testing-contexts* []) - (set! *report-counters* (update *report-counters* :error inc)) - (set! *test-result* false) - (println "ERROR in test:" e))))] - ((join-fixtures *once-fixtures*) - (fn [] - (if (seq nss) - (doseq [s nss] - (let [old-ns *ns*] - (in-ns s) - (doseq [t (get *registered-tests* *ns* [])] - (set! *report-counters* (update *report-counters* :test inc)) - (runner t)) - (in-ns (symbol (name old-ns))))) - ;; Run every registered ns's tests IN that ns, so runtime name - ;; resolution inside a test (resolve, *ns*, aliases) matches the ns - ;; the test was defined in — not whatever ns run-tests was called from. - ;; Keys are namespace objects, so derive the name via ns-name. - (doseq [[s bs] *registered-tests*] - (let [old-ns *ns*] - (in-ns (ns-name s)) - (doseq [t bs] - (set! *report-counters* (update *report-counters* :test inc)) - (runner t)) - (in-ns (ns-name old-ns)))))))) + ((join-fixtures *once-fixtures*) + (fn [] + (if (seq nss) + (doseq [s nss] + (let [old-ns *ns*] + (in-ns s) + (doseq [t (get *registered-tests* *ns* [])] + (set! *report-counters* (update *report-counters* :test inc)) + (test-var* t)) + (in-ns (symbol (name old-ns))))) + ;; Run every registered ns's tests IN that ns, so runtime name + ;; resolution inside a test (resolve, *ns*, aliases) matches the ns + ;; the test was defined in — not whatever ns run-tests was called from. + ;; Keys are namespace objects, so derive the name via ns-name. + (doseq [[s bs] *registered-tests*] + (let [old-ns *ns*] + (in-ns (ns-name s)) + (doseq [t bs] + (set! *report-counters* (update *report-counters* :test inc)) + (test-var* t)) + (in-ns (ns-name old-ns))))))) (let [c *report-counters*] (println "Finished running tests. Tests:" (:test c) "Pass:" (:pass c) "Fail:" (:fail c) "Error:" (:error c)) (set! *test-result* (and (= 0 (:fail c)) (= 0 (:error c)))))) +(defn run-test-var + "Run a single test var and return the report counters + ({:test :pass :fail :error}). The var runs through the same + *once-fixtures* / *each-fixtures* composition as run-tests, and inside + the namespace it was defined in (:ns of its metadata, which deftest + attaches), so one test behaves the way the whole suite does. A thrown + test body counts as an :error rather than escaping. This is what editors + call to run the test under the cursor; see also the run-test macro. + + The counters are bound, not set, for the duration of the run — as + clojure.test does — so running one test from inside another test, or + from a REPL in the middle of a suite, cannot overwrite the enclosing + run's tally or clear its failure flag." + [v] + (let [old-ns *ns*] + (binding [*report-counters* {:test 1 :pass 0 :fail 0 :error 0} + *test-result* true + *testing-contexts* []] + (in-ns (ns-name (or (:ns (meta v)) *ns*))) + (try + ((join-fixtures *once-fixtures*) (fn [] (test-var* v))) + (finally + (in-ns (ns-name old-ns)))) + (let [c *report-counters*] + (println "Finished running test. Tests:" (:test c) "Pass:" (:pass c) "Fail:" (:fail c) "Error:" (:error c)) + c)))) + +(defmacro run-test + "Run the named test and return its report counters: + (run-test my-test). Sugar for (run-test-var (var my-test))." + [name] + `(run-test-var (var ~name))) + (defn testing-contexts-str [] (str (apply str (interpose " > " *testing-contexts*)))) diff --git a/pkg/rt/core_compiled.lgb b/pkg/rt/core_compiled.lgb index 28c7d0f5d..f8472f443 100644 Binary files a/pkg/rt/core_compiled.lgb and b/pkg/rt/core_compiled.lgb differ diff --git a/pkg/rt/generated.sums b/pkg/rt/generated.sums index e472f577d..2047ce653 100644 --- a/pkg/rt/generated.sums +++ b/pkg/rt/generated.sums @@ -2,4 +2,4 @@ # Content digest of all .lg + lgbgen sources that feed the .lgb # bundle and the lowered Go tree. The genmanifest staleness test # fails if this no longer matches the sources on disk. -d4343b5f89a3d636b273089e2944bd8e27f596975f2eff3dd67b685d5f378623 +09573140e5fca8b882590526f778b496cd2acdad46d23a5ae225e4764989ef9b diff --git a/test/run_test_var_test.lg b/test/run_test_var_test.lg new file mode 100644 index 000000000..f6369d6d4 --- /dev/null +++ b/test/run_test_var_test.lg @@ -0,0 +1,127 @@ +;; Behavior tests for test/run-test-var and the run-test macro — the +;; single-var entry point editors use for "run the test under the cursor" +;; (clj-pulse resolves clojure.test/run-test-var, which aliases here). +;; +;; The point of run-test-var over `((deref v))` is that it goes through the +;; same *once-fixtures* / *each-fixtures* composition and the same +;; namespace switch as run-tests, so one test behaves the way the whole +;; suite does — while binding the counters so it never disturbs the run it +;; was called from. +;; +;; Harness note: this file's own tests run under the shared TestRunner, +;; which asserts *test-result* after (run-tests). The probes that must fail +;; or throw are therefore plain (def name (fn [] ...)) vars rather than +;; deftests — a registered one would be run by the harness itself. + +(ns test.run-test-var-test + (:require [test :refer :all])) + +;; --- probes ----------------------------------------------------------- + +(deftest sample-passing + (is (= 1 1))) + +(def sample-failing (fn [] (is (= 1 2)))) + +(def sample-throwing (fn [] (throw (ex-info "boom" {})))) + +;; Namespace probe: its metadata says it lives in `string`, so run-test-var +;; must in-ns there before invoking it and come back afterwards. +(def observed-ns (atom nil)) + +(def foreign-probe (fn [] (reset! observed-ns (ns-name *ns*)))) +(alter-meta! (var foreign-probe) assoc :ns (find-ns 'string)) + +(def fixture-events (atom [])) + +(defn- logging-fixture [before after] + (fn [t] + (swap! fixture-events conj before) + (t) + (swap! fixture-events conj after))) + +(defn- with-fixtures + "Run thunk f with the given :each / :once fixtures installed. Fixtures + are global state, so bind them rather than calling use-fixtures — + otherwise they leak into every test file that runs after this one." + [each once f] + (binding [test/*each-fixtures* each + test/*once-fixtures* once] + (f))) + +;; --- counters --------------------------------------------------------- + +(deftest run-test-var-counts-a-passing-test + (let [c (run-test-var (var sample-passing))] + (is (= 1 (:test c))) + (is (= 1 (:pass c))) + (is (= 0 (:fail c))) + (is (= 0 (:error c))))) + +(deftest run-test-var-counts-a-failing-assertion + ;; The inner run prints "FAIL (= 1 2)" — that is the probe failing on + ;; purpose, not this file failing. + (let [c (run-test-var (var sample-failing))] + (is (= 1 (:test c))) + (is (= 1 (:fail c))) + (is (= 0 (:error c))))) + +(deftest run-test-var-counts-a-throwing-test + ;; A thrown body is an :error, and must not propagate to the caller. + (let [c (run-test-var (var sample-throwing))] + (is (= 1 (:test c))) + (is (= 1 (:error c))) + (is (= 0 (:pass c))))) + +;; --- isolation from the enclosing run --------------------------------- + +(deftest a-nested-run-leaves-the-enclosing-run-untouched + ;; This test is itself running under run-tests. Running a failing and a + ;; throwing test inside it must not touch the suite's tally and must not + ;; clear *test-result* — otherwise a nested run could erase an earlier + ;; failure and let a broken suite report success. + (let [before test/*report-counters*] + (run-test-var (var sample-failing)) + (run-test-var (var sample-throwing)) + (is (= before test/*report-counters*)) + (is (= true test/*test-result*)))) + +;; --- fixtures --------------------------------------------------------- + +(deftest run-test-var-applies-once-and-each-fixtures + (reset! fixture-events []) + (let [c (with-fixtures [(logging-fixture :each-before :each-after)] + [(logging-fixture :once-before :once-after)] + (fn [] (run-test-var (var sample-passing))))] + (is (= 1 (:pass c))) + (is (= [:once-before :each-before :each-after :once-after] @fixture-events)))) + +;; --- namespace handling ----------------------------------------------- + +(deftest run-test-var-runs-in-the-vars-namespace + (reset! observed-ns nil) + (let [before (ns-name *ns*)] + (run-test-var (var foreign-probe)) + (is (= 'string @observed-ns)) + (is (= before (ns-name *ns*))))) + +(deftest run-test-var-restores-the-namespace-after-a-throw + (let [before (ns-name *ns*)] + (run-test-var (var sample-throwing)) + (is (= before (ns-name *ns*))))) + +;; --- deftest metadata ------------------------------------------------- + +(deftest deftest-records-clojure-test-var-metadata + (let [m (meta (var sample-passing))] + (is (= 'sample-passing (:name m))) + (is (= 'test.run-test-var-test (ns-name (:ns m)))) + ;; :test holds the test fn, as in clojure.test — not a boolean marker. + (is (fn? (:test m))))) + +;; --- run-test macro --------------------------------------------------- + +(deftest run-test-macro-matches-run-test-var + (let [via-macro (run-test sample-passing) + via-fn (run-test-var (var sample-passing))] + (is (= via-fn via-macro))))