diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn index e27865ec..e4db19e4 100644 --- a/.clj-kondo/config.edn +++ b/.clj-kondo/config.edn @@ -3,4 +3,5 @@ babashka.impl.Pattern/gen-wrapper-fn clojure.core/def babashka.impl.File/gen-wrapper-fn-2 clojure.core/def babashka.impl.Pattern/gen-wrapper-fn-2 clojure.core/def - babashka.impl.Pattern/gen-constants clojure.core/declare}} + babashka.impl.Pattern/gen-constants clojure.core/declare} + :linters {:unsorted-namespaces {:level :warning}}} diff --git a/sci b/sci index 0f7aa220..2474e34e 160000 --- a/sci +++ b/sci @@ -1 +1 @@ -Subproject commit 0f7aa2204dc7176a3ad383b1bd49031a17c8f0d0 +Subproject commit 2474e34eb071c69b9b9140325722008d4e986a6d diff --git a/src/babashka/impl/clojure/test.clj b/src/babashka/impl/clojure/test.clj new file mode 100644 index 00000000..4d1ecc95 --- /dev/null +++ b/src/babashka/impl/clojure/test.clj @@ -0,0 +1,801 @@ + ; 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. + +;;; test.clj: test framework for Clojure + +;; by Stuart Sierra +;; March 28, 2009 + +;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for +;; contributions and suggestions. + +(ns + ^{:author "Stuart Sierra, with contributions and suggestions by + Chas Emerick, Allen Rohner, and Stuart Halloway", + :doc "A unit testing framework. + + ASSERTIONS + + The core of the library is the \"is\" macro, which lets you make + assertions of any arbitrary expression: + + (is (= 4 (+ 2 2))) + (is (instance? Integer 256)) + (is (.startsWith \"abcde\" \"ab\")) + + You can type an \"is\" expression directly at the REPL, which will + print a message if it fails. + + user> (is (= 5 (+ 2 2))) + + FAIL in (:1) + expected: (= 5 (+ 2 2)) + actual: (not (= 5 4)) + false + + The \"expected:\" line shows you the original expression, and the + \"actual:\" shows you what actually happened. In this case, it + shows that (+ 2 2) returned 4, which is not = to 5. Finally, the + \"false\" on the last line is the value returned from the + expression. The \"is\" macro always returns the result of the + inner expression. + + There are two special assertions for testing exceptions. The + \"(is (thrown? c ...))\" form tests if an exception of class c is + thrown: + + (is (thrown? ArithmeticException (/ 1 0))) + + \"(is (thrown-with-msg? c re ...))\" does the same thing and also + tests that the message on the exception matches the regular + expression re: + + (is (thrown-with-msg? ArithmeticException #\"Divide by zero\" + (/ 1 0))) + + DOCUMENTING TESTS + + \"is\" takes an optional second argument, a string describing the + assertion. This message will be included in the error report. + + (is (= 5 (+ 2 2)) \"Crazy arithmetic\") + + In addition, you can document groups of assertions with the + \"testing\" macro, which takes a string followed by any number of + assertions. The string will be included in failure reports. + Calls to \"testing\" may be nested, and all of the strings will be + joined together with spaces in the final report, in a style + similar to RSpec + + (testing \"Arithmetic\" + (testing \"with positive integers\" + (is (= 4 (+ 2 2))) + (is (= 7 (+ 3 4)))) + (testing \"with negative integers\" + (is (= -4 (+ -2 -2))) + (is (= -1 (+ 3 -4))))) + + Note that, unlike RSpec, the \"testing\" macro may only be used + INSIDE a \"deftest\" or \"with-test\" form (see below). + + + DEFINING TESTS + + There are two ways to define tests. The \"with-test\" macro takes + a defn or def form as its first argument, followed by any number + of assertions. The tests will be stored as metadata on the + definition. + + (with-test + (defn my-function [x y] + (+ x y)) + (is (= 4 (my-function 2 2))) + (is (= 7 (my-function 3 4)))) + + As of Clojure SVN rev. 1221, this does not work with defmacro. + See http://code.google.com/p/clojure/issues/detail?id=51 + + The other way lets you define tests separately from the rest of + your code, even in a different namespace: + + (deftest addition + (is (= 4 (+ 2 2))) + (is (= 7 (+ 3 4)))) + + (deftest subtraction + (is (= 1 (- 4 3))) + (is (= 3 (- 7 4)))) + + This creates functions named \"addition\" and \"subtraction\", which + can be called like any other function. Therefore, tests can be + grouped and composed, in a style similar to the test framework in + Peter Seibel's \"Practical Common Lisp\" + + + (deftest arithmetic + (addition) + (subtraction)) + + The names of the nested tests will be joined in a list, like + \"(arithmetic addition)\", in failure reports. You can use nested + tests to set up a context shared by several tests. + + + RUNNING TESTS + + Run tests with the function \"(run-tests namespaces...)\": + + (run-tests 'your.namespace 'some.other.namespace) + + If you don't specify any namespaces, the current namespace is + used. To run all tests in all namespaces, use \"(run-all-tests)\". + + By default, these functions will search for all tests defined in + a namespace and run them in an undefined order. However, if you + are composing tests, as in the \"arithmetic\" example above, you + probably do not want the \"addition\" and \"subtraction\" tests run + separately. In that case, you must define a special function + named \"test-ns-hook\" that runs your tests in the correct order: + + (defn test-ns-hook [] + (arithmetic)) + + Note: test-ns-hook prevents execution of fixtures (see below). + + + OMITTING TESTS FROM PRODUCTION CODE + + You can bind the variable \"*load-tests*\" to false when loading or + compiling code in production. This will prevent any tests from + being created by \"with-test\" or \"deftest\". + + + FIXTURES + + Fixtures allow you to run code before and after tests, to set up + the context in which tests should be run. + + A fixture is just a function that calls another function passed as + an argument. It looks like this: + + (defn my-fixture [f] + Perform setup, establish bindings, whatever. + (f) Then call the function we were passed. + Tear-down / clean-up code here. + ) + + Fixtures are attached to namespaces in one of two ways. \"each\" + fixtures are run repeatedly, once for each test function created + with \"deftest\" or \"with-test\". \"each\" fixtures are useful for + establishing a consistent before/after state for each test, like + clearing out database tables. + + \"each\" fixtures can be attached to the current namespace like this: + (use-fixtures :each fixture1 fixture2 ...) + The fixture1, fixture2 are just functions like the example above. + They can also be anonymous functions, like this: + (use-fixtures :each (fn [f] setup... (f) cleanup...)) + + The other kind of fixture, a \"once\" fixture, is only run once, + around ALL the tests in the namespace. \"once\" fixtures are useful + for tasks that only need to be performed once, like establishing + database connections, or for time-consuming tasks. + + Attach \"once\" fixtures to the current namespace like this: + (use-fixtures :once fixture1 fixture2 ...) + + Note: Fixtures and test-ns-hook are mutually incompatible. If you + are using test-ns-hook, fixture functions will *never* be run. + + + SAVING TEST OUTPUT TO A FILE + + All the test reporting functions write to the var *test-out*. By + default, this is the same as *out*, but you can rebind it to any + PrintWriter. For example, it could be a file opened with + clojure.java.io/writer. + + + EXTENDING TEST-IS (ADVANCED) + + You can extend the behavior of the \"is\" macro by defining new + methods for the \"assert-expr\" multimethod. These methods are + called during expansion of the \"is\" macro, so they should return + quoted forms to be evaluated. + + You can plug in your own test-reporting framework by rebinding + the \"report\" function: (report event) + + The 'event' argument is a map. It will always have a :type key, + whose value will be a keyword signaling the type of event being + reported. Standard events with :type value of :pass, :fail, and + :error are called when an assertion passes, fails, and throws an + exception, respectively. In that case, the event will also have + the following keys: + + :expected The form that was expected to be true + :actual A form representing what actually occurred + :message The string message given as an argument to 'is' + + The \"testing\" strings will be a list in \"*testing-contexts*\", and + the vars being tested will be a list in \"*testing-vars*\". + + Your \"report\" function should wrap any printing calls in the + \"with-test-out\" macro, which rebinds *out* to the current value + of *test-out*. + + For additional event types, see the examples in the code. +"} + babashka.impl.clojure.test + (:require [babashka.impl.clojure.stacktrace :as stack] + [babashka.impl.common :refer [ctx]] + [clojure.string :as str] + [clojure.template :as temp] + [sci.core :as sci] + [sci.impl.analyzer :as ana] + [sci.impl.namespaces :as sci-namespaces] + [sci.impl.vars :as vars])) + +;; Nothing is marked "private" here, so you can rebind things to plug +;; in your own testing or reporting frameworks. + + +;;; USER-MODIFIABLE GLOBALS + +(defonce + ^{:doc "True by default. If set to false, no test functions will + be created by deftest, set-test, or with-test. Use this to omit + tests when compiling or loading production code."} + load-tests + (sci/new-dynamic-var '*load-tests* true)) + +(def + ^{:doc "The maximum depth of stack traces to print when an Exception + is thrown during a test. Defaults to nil, which means print the + complete stack trace."} + stack-trace-depth + (sci/new-dynamic-var '*stack-trace-depth* nil)) + + +;;; GLOBALS USED BY THE REPORTING FUNCTIONS + +(def report-counters (sci/new-dynamic-var '*report-counters* nil)) ; bound to a ref of a map in test-ns + +(def initial-report-counters ; used to initialize *report-counters* + (sci/new-dynamic-var '*initial-report-counters* {:test 0, :pass 0, :fail 0, :error 0})) + +(def testing-vars (sci/new-dynamic-var '*testing-vars* (list))) ; bound to hierarchy of vars being tested + +(def testing-contexts (sci/new-dynamic-var '*testing-contexts* (list))) ; bound to hierarchy of "testing" strings + +(def test-out (sci/new-dynamic-var '*test-out* sci/out)) ; PrintWriter for test reporting output + +(defmacro with-test-out-internal + "Runs body with *out* bound to the value of *test-out*." + {:added "1.1"} + [& body] + `(sci/binding [sci/out @test-out] + ~@body)) + +;;; UTILITIES FOR REPORTING FUNCTIONS + +(defn file-position + "Returns a vector [filename line-number] for the nth call up the + stack. + + Deprecated in 1.2: The information needed for test reporting is + now on :file and :line keys in the result map." + {:added "1.1" + :deprecated "1.2"} + [n] + (let [^StackTraceElement s (nth (.getStackTrace (new java.lang.Throwable)) n)] + [(.getFileName s) (.getLineNumber s)])) + +(defn testing-vars-str + "Returns a string representation of the current test. Renders names + in *testing-vars* as a list, then the source file and line of + current assertion." + {:added "1.1"} + [m] + (let [{:keys [file line]} m] + (str + ;; Uncomment to include namespace in failure report: + ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ " + (reverse (map #(:name (meta %)) @testing-vars)) + " (" file ":" line ")"))) + +(defn testing-contexts-str + "Returns a string representation of the current test context. Joins + strings in *testing-contexts* with spaces." + {:added "1.1"} + [] + (apply str (interpose " " (reverse @testing-contexts)))) + +(defn inc-report-counter + "Increments the named counter in *report-counters*, a ref to a map. + Does nothing if *report-counters* is nil." + {:added "1.1"} + [name] + (when @report-counters + (swap! @report-counters update-in [name] (fnil inc 0)))) + +;;; TEST RESULT REPORTING + +(defmulti + ^{:doc "Generic reporting function, may be overridden to plug in + different report formats (e.g., TAP, JUnit). Assertions such as + 'is' call 'report' to indicate results. The argument given to + 'report' will be a map with a :type key. See the documentation at + the top of test_is.clj for more information on the types of + arguments for 'report'." + :dynamic true + :added "1.1"} + report :type) + +#_(defn- file-and-line + {:deprecated "1.8"} + [^Throwable exception depth] + (let [stacktrace (.getStackTrace exception)] + (if (< depth (count stacktrace)) + (let [^StackTraceElement s (nth stacktrace depth)] + {:file (.getFileName s) :line (.getLineNumber s)}) + {:file nil :line nil}))) + +(defn- stacktrace-file-and-line + [stacktrace] + (if (seq stacktrace) + (let [^StackTraceElement s (first stacktrace)] + {:file (.getFileName s) :line (.getLineNumber s)}) + {:file nil :line nil})) + +(defn do-report + "Add file and line information to a test result and call report. + If you are writing a custom assert-expr method, call this function + to pass test results to report." + {:added "1.2"} + [m] + (report + (case + (:type m) + :fail (merge (stacktrace-file-and-line (drop-while + #(let [cl-name (.getClassName ^StackTraceElement %)] + (or (str/starts-with? cl-name "java.lang.") + (str/starts-with? cl-name "clojure.test$") + (str/starts-with? cl-name "clojure.core$ex_info"))) + (.getStackTrace (Thread/currentThread)))) m) + :error (merge (stacktrace-file-and-line (.getStackTrace ^Throwable (:actual m))) m) + m))) + +(defmethod report :default [m] + (with-test-out-internal (prn m))) + +(defmethod report :pass [m] + (with-test-out-internal (inc-report-counter :pass))) + +(defmethod report :fail [m] + (with-test-out-internal + (inc-report-counter :fail) + (println "\nFAIL in" (testing-vars-str m)) + (when (seq @testing-contexts) (println (testing-contexts-str))) + (when-let [message (:message m)] (println message)) + (println "expected:" (pr-str (:expected m))) + (println " actual:" (pr-str (:actual m))))) + +(defmethod report :error [m] + (with-test-out-internal + (inc-report-counter :error) + (println "\nERROR in" (testing-vars-str m)) + (when (seq @testing-contexts) (println (testing-contexts-str))) + (when-let [message (:message m)] (println message)) + (println "expected:" (pr-str (:expected m))) + (print " actual: ") + (let [actual (:actual m)] + (if (instance? Throwable actual) + (stack/print-cause-trace actual @stack-trace-depth) + (prn actual))))) + +(defmethod report :summary [m] + (with-test-out-internal + (println "\nRan" (:test m) "tests containing" + (+ (:pass m) (:fail m) (:error m)) "assertions.") + (println (:fail m) "failures," (:error m) "errors."))) + +(defmethod report :begin-test-ns [m] + (with-test-out-internal + (println "\nTesting" (sci-namespaces/sci-ns-name (:ns m))))) + +;; Ignore these message types: +(defmethod report :end-test-ns [m]) +(defmethod report :begin-test-var [m]) +(defmethod report :end-test-var [m]) + + + +;;; UTILITIES FOR ASSERTIONS + +(defn function? + "Returns true if argument is a function or a symbol that resolves to + a function (not a macro)." + {:added "1.1"} + [x] + (if (symbol? x) ;; TODO + (when-let [v (second (ana/lookup @ctx x false))] + (when-let [value (if (vars/var? v) @v v)] + (and (fn? value) + (not (:sci/macro (meta v)))))) + (fn? x))) + +(defn assert-predicate + "Returns generic assertion code for any functional predicate. The + 'expected' argument to 'report' will contains the original form, the + 'actual' argument will contain the form with all its sub-forms + evaluated. If the predicate returns false, the 'actual' form will + be wrapped in (not...)." + {:added "1.1"} + [msg form] + (let [args (rest form) + pred (first form)] + `(let [values# (list ~@args) + result# (apply ~pred values#)] + (if result# + (clojure.test/do-report {:type :pass, :message ~msg, + :expected '~form, :actual (cons ~pred values#)}) + (clojure.test/do-report {:type :fail, :message ~msg, + :expected '~form, :actual (list '~'not (cons '~pred values#))})) + result#))) + +(defn assert-any + "Returns generic assertion code for any test, including macros, Java + method calls, or isolated symbols." + {:added "1.1"} + [msg form] + `(let [value# ~form] + (if value# + (clojure.test/do-report {:type :pass, :message ~msg, + :expected '~form, :actual value#}) + (clojure.test/do-report {:type :fail, :message ~msg, + :expected '~form, :actual value#})) + value#)) + + + +;;; ASSERTION METHODS + +;; You don't call these, but you can add methods to extend the 'is' +;; macro. These define different kinds of tests, based on the first +;; symbol in the test expression. + +(defmulti assert-expr + (fn [msg form] + (cond + (nil? form) :always-fail + (seq? form) (first form) + :else :default))) + +(defmethod assert-expr :always-fail [msg form] + ;; nil test: always fail + `(clojure.test/do-report {:type :fail, :message ~msg})) + +(defmethod assert-expr :default [msg form] + (if (and (sequential? form) (function? (first form))) + (assert-predicate msg form) + (assert-any msg form))) + +(defmethod assert-expr 'instance? [msg form] + ;; Test if x is an instance of y. + `(let [klass# ~(nth form 1) + object# ~(nth form 2)] + (let [result# (instance? klass# object#)] + (if result# + (clojure.test/do-report {:type :pass, :message ~msg, + :expected '~form, :actual (class object#)}) + (clojure.test/do-report {:type :fail, :message ~msg, + :expected '~form, :actual (class object#)})) + result#))) + +(defmethod assert-expr 'thrown? [msg form] + ;; (is (thrown? c expr)) + ;; Asserts that evaluating expr throws an exception of class c. + ;; Returns the exception thrown. + (let [klass (second form) + body (nthnext form 2)] + `(try ~@body + (clojure.test/do-report {:type :fail, :message ~msg, + :expected '~form, :actual nil}) + (catch ~klass e# + (clojure.test/do-report {:type :pass, :message ~msg, + :expected '~form, :actual e#}) + e#)))) + +(defmethod assert-expr 'thrown-with-msg? [msg form] + ;; (is (thrown-with-msg? c re expr)) + ;; Asserts that evaluating expr throws an exception of class c. + ;; Also asserts that the message string of the exception matches + ;; (with re-find) the regular expression re. + (let [klass (nth form 1) + re (nth form 2) + body (nthnext form 3)] + `(try ~@body + (clojure.test/do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) + (catch ~klass e# + (let [m# (.getMessage e#)] + (if (re-find ~re m#) + (clojure.test/do-report {:type :pass, :message ~msg, + :expected '~form, :actual e#}) + (clojure.test/do-report {:type :fail, :message ~msg, + :expected '~form, :actual e#}))) + e#)))) + + +(defmacro try-expr + "Used by the 'is' macro to catch unexpected exceptions. + You don't call this." + {:added "1.1"} + [msg form] + `(try ~(assert-expr msg form) + (catch Throwable t# + (clojure.test/do-report {:type :error, :message ~msg, + :expected '~form, :actual t#})))) + + + +;;; ASSERTION MACROS + +;; You use these in your tests. + +(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." + {:added "1.1"} + ([form] + `(clojure.test/is ~form nil)) + ([form msg] `(clojure.test/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." + {:added "1.1"} + [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))))) + `(temp/do-template ~argv (clojure.test/is ~expr) ~@args) + (throw (IllegalArgumentException. "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)." + {:added "1.1"} + [string & body] + `(binding [clojure.test/*testing-contexts* (conj clojure.test/*testing-contexts* ~string)] + ~@body)) + + + +;;; DEFINING TESTS + +(defmacro with-test + "Takes any definition form (that returns a Var) as the first argument. + Remaining body goes in the :test metadata function for that Var. + + When *load-tests* is false, only evaluates the definition, ignoring + the tests." + {:added "1.1"} + [definition & body] + (if @load-tests + `(doto ~definition (alter-meta! assoc :test (fn [] ~@body))) + definition)) + + +(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 *load-tests* is false, deftest is ignored." + {:added "1.1"} + [name & body] + (when @load-tests + `(def ~(vary-meta name assoc :test `(fn [] ~@body)) + (fn [] (clojure.test/test-var (var ~name)))))) + +(defmacro deftest- + "Like deftest but creates a private var." + {:added "1.1"} + [name & body] + (when @load-tests + `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true) + (fn [] (test-var (var ~name)))))) + + +(defmacro set-test + "Experimental. + Sets :test metadata of the named var to a fn with the given body. + The var must already exist. Does not modify the value of the var. + + When *load-tests* is false, set-test is ignored." + {:added "1.1"} + [name & body] + (when @load-tests + `(alter-meta! (var ~name) assoc :test (fn [] ~@body)))) + + + +;;; DEFINING FIXTURES + +(def ^:private ns->fixtures (atom {})) + +(defn- add-ns-meta + "Adds elements in coll to the current namespace metadata as the + value of key." + {:added "1.1"} + [key coll] + (swap! ns->fixtures assoc-in [(sci-namespaces/sci-ns-name @vars/current-ns) key] coll)) + +(defmulti use-fixtures + "Wrap test runs in a fixture function to perform setup and + teardown. Using a fixture-type of :each wraps every test + individually, while :once wraps the whole run in a single function." + {:added "1.1"} + (fn [fixture-type & args] fixture-type)) + +(defmethod use-fixtures :each [fixture-type & args] + (add-ns-meta ::each-fixtures args)) + +(defmethod use-fixtures :once [fixture-type & args] + (add-ns-meta ::once-fixtures args)) + +(defn- default-fixture + "The default, empty, fixture function. Just calls its argument." + {:added "1.1"} + [f] + (f)) + +(defn compose-fixtures + "Composes two fixture functions, creating a new fixture function + that combines their behavior." + {:added "1.1"} + [f1 f2] + (fn [g] (f1 (fn [] (f2 g))))) + +(defn join-fixtures + "Composes a collection of fixtures, in order. Always returns a valid + fixture function, even if the collection is empty." + {:added "1.1"} + [fixtures] + (reduce compose-fixtures default-fixture fixtures)) + + + + +;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS + +(defn test-var + "If v has a function in its :test metadata, calls that function, + with *testing-vars* bound to (conj *testing-vars* v)." + {:dynamic true, :added "1.1"} + [v] + (when-let [t (:test (meta v))] + (sci/binding [testing-vars (conj @testing-vars v)] + (do-report {:type :begin-test-var, :var v}) + (inc-report-counter :test) + (try (t) + (catch Throwable e + (do-report {:type :error, :message "Uncaught exception, not in assertion." + :expected nil, :actual e}))) + (do-report {:type :end-test-var, :var v})))) + +(defn test-vars + "Groups vars by their namespace and runs test-vars on them with + appropriate fixtures applied." + {:added "1.6"} + [vars] + (doseq [[ns vars] (group-by (comp :ns meta) vars) + :when ns] + (let [ns-name (sci-namespaces/sci-ns-name ns) + fixtures (get @ns->fixtures ns-name) + once-fixture-fn (join-fixtures (::once-fixtures fixtures)) + each-fixture-fn (join-fixtures (::each-fixtures fixtures))] + (once-fixture-fn + (fn [] + (doseq [v vars] + (when (:test (meta v)) + (each-fixture-fn (fn [] (test-var v)))))))))) + +(defn test-all-vars + "Calls test-vars on every var interned in the namespace, with fixtures." + {:added "1.1"} + [ctx ns] + (test-vars (vals (sci-namespaces/sci-ns-interns ctx ns)))) + +(defn 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*. Returns the final, dereferenced state of + *report-counters*." + {:added "1.1"} + [ctx ns] + (sci/binding [report-counters (atom @initial-report-counters)] + (let [ns-obj (sci-namespaces/sci-the-ns ctx ns)] + (do-report {:type :begin-test-ns, :ns ns-obj}) + ;; If the namespace has a test-ns-hook function, call that: + (let [ns-sym (sci-namespaces/sci-ns-name ns-obj)] + (if-let [v (get-in @(:env ctx) [:namespaces ns-sym 'test-ns-hook])] + (@v) + ;; Otherwise, just test every var in the namespace. + (test-all-vars ctx ns-obj))) + (do-report {:type :end-test-ns, :ns ns-obj})) + @@report-counters)) + + + +;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS + +(defn run-tests + "Runs all tests in the given namespaces; prints results. + Defaults to current namespace if none given. Returns a map + summarizing test results." + {:added "1.1"} + ([ctx] (run-tests ctx @vars/current-ns)) + ([ctx & namespaces] + (let [summary (assoc (apply merge-with + (map #(test-ns ctx %) namespaces)) + :type :summary)] + (do-report summary) + summary))) + +(defn 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." + {:added "1.1"} + ([ctx] (apply run-tests ctx (sci-namespaces/sci-all-ns ctx))) + ([ctx re] (apply run-tests ctx + (filter #(re-matches re (name (sci-namespaces/sci-ns-name %))) + (sci-namespaces/sci-all-ns ctx))))) + +(defn successful? + "Returns true if the given test summary indicates all tests + were successful, false otherwise." + {:added "1.1"} + [summary] + (and (zero? (:fail summary 0)) + (zero? (:error summary 0)))) diff --git a/src/babashka/impl/common.clj b/src/babashka/impl/common.clj new file mode 100644 index 00000000..938b89a6 --- /dev/null +++ b/src/babashka/impl/common.clj @@ -0,0 +1,4 @@ +(ns babashka.impl.common) + +;; placeholder for ctx +(def ctx (volatile! nil)) diff --git a/src/babashka/impl/test.clj b/src/babashka/impl/test.clj new file mode 100644 index 00000000..9a7a59b3 --- /dev/null +++ b/src/babashka/impl/test.clj @@ -0,0 +1,55 @@ +(ns babashka.impl.test + (:require [babashka.impl.clojure.test :as t])) + +(defn macrofy [v] + (with-meta v {:sci/macro true})) + +(defn contextualize [v] + (with-meta v {:sci.impl/op :needs-ctx})) + +(def clojure-test-namespace + {'*load-tests* t/load-tests + '*stack-trace-depth* t/stack-trace-depth + '*report-counters* t/report-counters + '*initial-report-counters* t/initial-report-counters + '*testing-vars* t/testing-vars + '*testing-contexts* t/testing-contexts + '*test-out* t/test-out + ;; 'with-test-out (macrofy @#'t/with-test-out) + ;; 'file-position t/file-position + 'testing-vars-str t/testing-vars-str + 'testing-contexts-str t/testing-contexts-str + 'inc-report-counter t/inc-report-counter + 'do-report t/do-report + ;; assertion utilities + 'function? t/function? + 'assert-predicate t/assert-predicate + 'assert-any t/assert-any + ;; assertion methods + 'assert-expr t/assert-expr + 'try-expr (with-meta @#'t/try-expr + {:sci/macro true}) + ;; assertion macros + 'is (with-meta @#'t/is + {;; :sci.impl/op :needs-ctx + :sci/macro true}) + 'are (macrofy @#'t/are) + 'testing (macrofy @#'t/testing) + ;; defining tests + 'with-test (macrofy @#'t/with-test) + 'deftest (macrofy @#'t/deftest) + 'deftest- (macrofy @#'t/deftest-) + 'set-test (macrofy @#'t/set-test) + ;; fixtures + 'use-fixtures t/use-fixtures + 'compose-fixtures t/compose-fixtures + 'join-fixtures t/join-fixtures + ;; running tests: low level + 'test-var t/test-var + 'test-vars t/test-vars + 'test-all-vars (with-meta t/test-all-vars {:sci.impl/op :needs-ctx}) + 'test-ns (with-meta t/test-ns {:sci.impl/op :needs-ctx}) + ;; running tests: high level + 'run-tests (contextualize t/run-tests) + 'run-all-tests (contextualize t/run-all-tests) + 'successful? t/successful?}) diff --git a/src/babashka/main.clj b/src/babashka/main.clj index 3b9293c1..4e87122e 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -10,10 +10,12 @@ [babashka.impl.clojure.java.shell :refer [shell-namespace]] [babashka.impl.clojure.main :refer [demunge]] [babashka.impl.clojure.stacktrace :refer [stacktrace-namespace print-stack-trace]] + [babashka.impl.common :as common] [babashka.impl.csv :as csv] [babashka.impl.pipe-signal-handler :refer [handle-pipe! pipe-signal-received?]] [babashka.impl.repl :as repl] [babashka.impl.socket-repl :as socket-repl] + [babashka.impl.test :as t] [babashka.impl.tools.cli :refer [tools-cli-namespace]] [babashka.wait :as wait] [clojure.edn :as edn] @@ -247,6 +249,7 @@ Everything after that is bound to *command-line-args*.")) 'clojure.stacktrace stacktrace-namespace 'clojure.main {'demunge demunge} 'clojure.repl {'demunge demunge} + 'clojure.test t/clojure-test-namespace 'babashka.classpath {'add-classpath add-classpath*}}) (def bindings @@ -337,6 +340,7 @@ Everything after that is bound to *command-line-args*.")) :dry-run uberscript} ctx (addons/future ctx) sci-ctx (sci-opts/init ctx) + _ (vreset! common/ctx sci-ctx) _ (swap! (:env sci-ctx) (fn [env] (update-in env [:namespaces 'clojure.core] assoc diff --git a/test-resources/babashka/assert_expr.clj b/test-resources/babashka/assert_expr.clj new file mode 100644 index 00000000..6983e91e --- /dev/null +++ b/test-resources/babashka/assert_expr.clj @@ -0,0 +1,21 @@ +(require '[clojure.test :refer [is deftest] :as t]) + +(defmethod t/assert-expr 'roughly [msg form] + `(let [op1# ~(nth form 1) + op2# ~(nth form 2) + tolerance# (if (= 4 ~(count form)) ~(last form) 2) + decimals# (/ 1. (Math/pow 10 tolerance#)) + result# (< (Math/abs (- op1# op2#)) decimals#)] + (t/do-report + {:type (if result# :pass :fail) + :message ~msg + :expected (format "%s should be roughly %s with %s tolerance" + op1# op2# decimals#) + :actual result#}) + result#)) + +(deftest PI-test + (is (roughly 3.14 Math/PI 2)) + (is (roughly 3.14 Math/PI 3))) + +(t/test-var #'PI-test) diff --git a/test/babashka/classpath_test.clj b/test/babashka/classpath_test.clj index eb592f5a..95fcc56b 100644 --- a/test/babashka/classpath_test.clj +++ b/test/babashka/classpath_test.clj @@ -2,8 +2,8 @@ (:require [babashka.test-utils :as tu] [clojure.edn :as edn] - [clojure.test :as t :refer [deftest is]] - [clojure.java.io :as io])) + [clojure.java.io :as io] + [clojure.test :as t :refer [deftest is]])) (defn bb [input & args] (edn/read-string (apply tu/bb (when (some? input) (str input)) (map str args)))) diff --git a/test/babashka/test_test.clj b/test/babashka/test_test.clj new file mode 100644 index 00000000..eb6bc975 --- /dev/null +++ b/test/babashka/test_test.clj @@ -0,0 +1,71 @@ +(ns babashka.test-test + (:require + [babashka.test-utils :as tu] + [clojure.string :as str] + [clojure.test :as t :refer [deftest is]] + [clojure.java.io :as io])) + +(defn bb [& args] + (apply tu/bb nil (map str args))) + +(deftest deftest-test + (is (str/includes? + (bb "(require '[clojure.test :as t]) (t/deftest foo (t/is (= 4 5))) (foo)") + "expected: (= 4 5)\n actual: (not (= 4 5))\n"))) + +(deftest run-tests-test + (let [output (bb "(require '[clojure.test :as t]) (t/deftest foo (t/is (= 4 5))) (t/run-tests)")] + (is (str/includes? output "Testing user")) + (is (str/includes? output "{:test 1, :pass 0, :fail 1, :error 0, :type :summary}")))) + +(deftest run-all-tests-test + (let [output (bb " +(require '[clojure.test :as t]) +(t/deftest foo (t/is (= 4 5))) +(ns foobar) +(require '[clojure.test :as t]) +(t/run-all-tests)")] + (is (str/includes? output "Testing user")) + (is (str/includes? output "Testing foobar")) + (is (str/includes? output "{:test 1, :pass 0, :fail 1, :error 0, :type :summary}")))) + +(deftest fixtures-test + (let [output (bb " +(require '[clojure.test :as t]) +(defn once [f] (prn :once-before) (f) (prn :once-after)) +(defn each [f] (prn :each-before) (f) (prn :each-after)) +(t/use-fixtures :once once) +(t/use-fixtures :each each) +(t/deftest foo) +(t/deftest bar) +(t/run-tests)")] + (is (str/includes? output (str/trim " +:once-before +:each-before +:each-after +:each-before +:each-after +:once-after"))))) + +(deftest with-test + (let [output (bb " +(require '[clojure.test :as t]) +(t/with-test + (defn my-function [x y] + (+ x y)) + (t/is (= 4 (my-function 2 2))) + (t/is (= 7 (my-function 3 4)))) +(t/run-tests)")] + (is (str/includes? output "Ran 1 tests containing 2 assertions.")))) + +(deftest testing-test + (is (str/includes? (bb "(require '[clojure.test :as t]) (t/testing \"foo\" (t/is (= 4 5)))") + "foo"))) + +(deftest are-test + (is (str/includes? (bb "(require '[clojure.test :as t]) (t/are [x y] (= x y) 2 (+ 1 2))") + "expected: (= 2 (+ 1 2))"))) + +(deftest assert-expr-test + (is (str/includes? (bb (.getPath (io/file "test-resources" "babashka" "assert_expr.clj"))) + "3.14 should be roughly 3.141592653589793")))