Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Clj 2525 test context throw #18

Draft
wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

Clj 2525 test context throw #18

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
25 changes: 25 additions & 0 deletions .github/workflows/build.yml
View file
Open in desktop
@@ -0,0 +1,25 @@
name: Java CI

on: [push]

jobs:
build:
strategy:
matrix:
jdk: ['8', '11', '17', '18']
runs-on: ubuntu-latest

steps:
- uses: actions/checkout@v2
- name: Set up JDK ${{ matrix.jdk }}
uses: actions/setup-java@v2
with:
java-version: ${{ matrix.jdk }}
distribution: 'temurin'
cache: maven
- name: Build with Maven
run: mvn test
- name: Configure settings.xml
run: |
mkdir -p ~/.m2
echo "<settings><servers><server><id>clojars</id><username>${{ secrets.CLOJARS_USER }}-clojars</username><password>${{ secrets.CLOJARS_PASSWORD }}</password></server></servers></settings>" > ~/.m2/settings.xml
2 changes: 2 additions & 0 deletions .gitignore
View file
Open in desktop
Expand Up @@ -7,3 +7,5 @@ maven-classpath
maven-classpath.properties
.idea/
*.iml
.cpcache
deps.edn
38 changes: 38 additions & 0 deletions deps.edn
View file
Open in desktop
@@ -0,0 +1,38 @@
;; https://clojure.org/dev/developing_patches#_run_an_individual_test
{:paths ["test"
"target/test-classes"]
:deps
{org.clojure/clojure {:local/root "."
:deps/manifest :pom} #_{:mvn/version "RELEASE"}
org.clojure/test.check {:mvn/version "1.1.1"}
org.clojure/test.generative {:mvn/version "1.0.0"}}
:aliases
{:dbg {:classpath-overrides {org.clojure/clojure "target/classes"}
:extra-deps {criterium/criterium {:mvn/version "0.4.4"}}}
:cognitest {:extra-deps {io.github.cognitect-labs/test-runner
{:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
:main-opts ["-m" "cognitect.test-runner"]
:exec-fn cognitect.test-runner.api/test
:exec-args {:dirs ["test"]
:patterns [;; FIXME clojure.test-clojure.ns-libs has a test that is sensitive to loading order
;; FIXME clojure.test-clojure.java-interop doesn't seem to work on JDK 17 (untested on others)
;; regex ref: https://stackoverflow.com/a/2387072
"^((?!(clojure.test-clojure.ns-libs|clojure.test-clojure.java-interop)).)*$"
]}}
:test-example-script {:jvm-opts [;; from build.xml
"-Dclojure.test-clojure.exclude-namespaces=#{clojure.test-clojure.compilation.load-ns clojure.test-clojure.ns-libs-load-later}"
"-Dclojure.compiler.direct-linking=true"]
:main-opts ["-e" "(load-file,\"src/script/run_test.clj\")"]}
:test-generative-script {:jvm-opts [;; from build.xml
"-Dclojure.compiler.direct-linking=true"]
:main-opts ["-e" "(load-file,\"src/script/run_test_generative.clj\")"]}

:kaocha {:extra-deps {lambdaisland/kaocha {:mvn/version "1.60.977"}}
:exec-fn kaocha.runner/exec-fn
:exec-args {;:watch? true
:tests [{:id :unit
:test-paths ["test"]
:ns-patterns [".*"]}]
:reporter kaocha.report/dots
;; :plugins [:kaocha.plugin/profiling :kaocha.plugin/notifier]
}}}}
50 changes: 45 additions & 5 deletions src/clj/clojure/test.clj
View file
Open in desktop
Expand Up @@ -83,6 +83,10 @@
Note that, unlike RSpec, the \"testing\" macro may only be used
INSIDE a \"deftest\" or \"with-test\" form (see below).

If an exception is thrown and bubbles to the top of the test, the
first \"testing\" form its root cause travelled through is used in
the error report.


DEFINING TESTS

Expand Down Expand Up @@ -268,6 +272,10 @@

(def ^:dynamic *testing-contexts* (list)) ; bound to hierarchy of "testing" strings

; bound to an atom that contains a map from (the root causes of) exceptions that bubble
; through "testing" forms to the first testing contexts it crosses.
(def ^:dynamic *exceptional-testing-contexts* nil)

(def ^:dynamic *test-out* *out*) ; PrintWriter for test reporting output

(defmacro with-test-out
Expand Down Expand Up @@ -594,13 +602,27 @@
`(temp/do-template ~argv (is ~expr) ~@args)
(throw (IllegalArgumentException. "The number of args doesn't match are's argv."))))

(defn record-uncaught-exception-contexts
"Record exception e as being thrown in the current testing
context unless it has already been recorded."
{:added "1.12"}
[e]
(some-> *exceptional-testing-contexts*
(swap! update (stack/root-cause e) #(or % *testing-contexts*))))

(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 [*testing-contexts* (conj *testing-contexts* ~string)]
~@body))
(try (do ~@body)
(catch Throwable e#
;; `resolve` for backwards compatibility. allows AOT compiled code by future Clojure versions to run on earlier ones.
;; eg., https://clojure.atlassian.net/browse/CLJ-2564?focusedCommentId=48791
(when-some [f# (resolve 'record-uncaught-exception-contexts)]
(f# e#))
(throw e#)))))



Expand Down Expand Up @@ -705,6 +727,27 @@

;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS

(defn report-uncaught-exception
"Report an uncaught exception using *exceptional-testing-contexts* to
guess the most helpful message."
{:added "1.12"}
[e]
(do-report {:type :error, :message (if-some [etc (some-> *exceptional-testing-contexts* deref (get (stack/root-cause e)))]
(binding [*testing-contexts* etc]
(testing-contexts-str))
"Uncaught exception, not in assertion.")
:expected nil, :actual e}))

(defn -run-test-body
"A low-level function to run the body of a test (a thunk) with improved
error messages on uncaught exceptions."
{:added "1.12"}
[f]
(binding [*exceptional-testing-contexts* (atom {})]
(try (f)
(catch Throwable e
(report-uncaught-exception e)))))

(defn test-var
"If v has a function in its :test metadata, calls that function,
with *testing-vars* bound to (conj *testing-vars* v)."
Expand All @@ -714,10 +757,7 @@
(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})))
(-run-test-body t)
(do-report {:type :end-test-var, :var v}))))

(defn test-vars
Expand Down
202 changes: 202 additions & 0 deletions test/clojure/test_clojure/test_uncaught.clj
View file
Open in desktop
@@ -0,0 +1,202 @@
; 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 clojure.test-clojure.test-uncaught
(:use clojure.test))

(def test-var-tests-prefix "test-var-exception-test-")

(defmacro deftests-for-test-var
"Define unit tests for clojure.test/test-var functionality. See
`test-ns-hook` in this namespace for special handling.

Each test should throw an exception with {::expected true} ex-data,
and the expected :error report :message should be attached via the ::expected-test-var-message
key of the test name's metadata."
[& ts]
{:pre [(even? (count ts))]}
`(do ~@(map (fn [[nme & body]]
{:pre [(simple-symbol? nme)]}
`(deftest ~(with-meta (symbol (str test-var-tests-prefix (name nme)))
(meta nme))
~@body))
(partition 2 ts))))

(deftests-for-test-var
;; testing that an expected error under an empty testing context gives "Uncaught exception, not in assertion."
^{::expected-test-var-message "Uncaught exception, not in assertion."}
thrown-from-empty-context-test
(throw (ex-info "" {::expected true}))

;; testing that a rethrown expected error under an empty testing context gives "Uncaught exception, not in assertion."
^{::expected-test-var-message "Uncaught exception, not in assertion."}
rethrown-between-empty-contexts-test
(let [e (try (binding [*testing-contexts* (list)]
(throw (ex-info "" {::expected true})))
(catch Exception e e))]
(binding [*testing-contexts* (list)]
(throw e)))

;; testing that an expected error under testing context "foo bar" gives "foo bar"
^{::expected-test-var-message "foo bar"}
nested-exception-test
(testing "foo"
(testing "bar"
(throw (ex-info "" {::expected true}))))

;; also works with longer testing contexts
^{::expected-test-var-message "foo bar 1 2 3 4 5"}
long-nested-exception-test
(testing "foo"
(testing "bar"
(testing "1"
(testing "2"
(testing "3"
(testing "4"
(testing "5"
(throw (ex-info "" {::expected true})))))))))

;; testing that exceptions that occur inside testing context "foo bar" gives "foo bar"
;; when rethrown in the same testing context.
^{::expected-test-var-message "foo bar"}
rethrown-nested-exception-test
(let [the-e (atom nil)]
(testing "foo"
(try (testing "bar"
(throw (reset! the-e (ex-info "" {::expected true}))))
(catch Exception e
(assert (identical? e @the-e))
(throw e)))))

;; testing that exceptions that occur inside testing context "foo bar" gives "foo bar"
;; when rethrown in a different (empty) testing context.
^{::expected-test-var-message "foo bar"}
rethrown-from-empty-context-test
(let [the-e (atom nil)]
(try
(testing "foo"
(testing "bar"
(throw (reset! the-e (ex-info "" {::expected true})))))
(catch Exception e
(assert (identical? @the-e e))
(throw e))))

;; crossing a `testing` context with exceptional control flow locks in the guess
;; for the final error message: "foo bar", not "adjacent". The rethrown context
;; is not reported.
^{::expected-test-var-message "foo bar"}
rethrown-from-adjacent-context
(let [the-e (atom nil)
e (testing "foo"
(try (testing "bar"
;; throw through "bar" but catch before "foo"
(throw (reset! the-e (ex-info "" {::expected true}))))
(catch Exception e
(assert (identical? @the-e e))
e)))]
(assert (identical? @the-e e))
(testing "adjacent"
(throw e)))

;; catching an exception before it crosses a `testing` scope "foo" allows rethrowing context
;; "adjacent" to be reported.
^{::expected-test-var-message "adjacent"}
thrown-in-non-nested-context-rethrown-from-adjacent-context
(let [the-e (atom nil)
e (testing "foo"
;; don't cross `testing` scopes when throwing
(try (throw (reset! the-e (ex-info "" {::expected true})))
(catch Exception e
(assert (identical? @the-e e))
e)))]
(assert (identical? @the-e e))
(testing "adjacent"
;; this is the first testing context we cross with exceptional control flow,
;; so "adjacent" is reported---not "foo"
(throw e)))

;; binding conveyance can be used to track exceptional contexts
^{::expected-test-var-message "foo bar baz"}
binding-conveyance-test
(testing "foo"
(testing "bar"
@(future
(testing "baz"
(throw (ex-info "" {::expected true}))))))

^{::expected-test-var-message "foo bar3"}
also-thrown-test
(testing "foo"
(try (testing "bar1"
(throw (ex-info "asdf1" {::expected false})))
(catch Exception _))
(try (testing "bar2"
(throw (ex-info "asdf2" {::expected false})))
(catch Exception _))
(testing "bar3"
(throw (ex-info "asdf3" {::expected true})))))

;; Here, we create an alternate version of test/report, that
;; compares the event with the message, then calls the original
;; 'report' with modified arguments.

(declare ^:dynamic original-report)

(defn custom-report [data]
(let [event (:type data)
msg (:message data)
expected (:expected data)
actual (:actual data)
passed (cond
(= event :fail) (= msg "Should fail")
(= event :pass) (= msg "Should pass")
(= event :error) (= msg "Should error")
:else true)]
(if passed
(original-report {:type :pass, :message msg,
:expected expected, :actual actual})
(original-report {:type :fail, :message (str msg " but got " event)
:expected expected, :actual actual}))))

(def this-ns-name (ns-name *ns*))

;; test-ns-hook will be used by test/test-ns to run tests in this
;; namespace.
(defn test-ns-hook []
(let [{test-var-test-vars true
other-test-vars false
:as all-groups} (group-by #(-> % symbol name (.startsWith test-var-tests-prefix))
(sort-by symbol (vals (ns-interns this-ns-name))))]
;; extra paranoid checks of group-by usage
(assert (= 2 (count all-groups)) (count all-groups))
(assert (seq test-var-test-vars))
(assert (seq other-test-vars))
(binding [original-report report
report custom-report]
(test-vars other-test-vars))
;; testing clojure.test/test-var
(doseq [v test-var-test-vars]
;; don't wrap in `testing` until _after_ test-var call
(let [rs (atom [])
actual (into []
(remove (comp #{:begin-test-var :end-test-var} :type))
(binding [report #(swap! rs conj %)]
(test-var v)))
expected [{:type :error :message (-> v meta ::expected-test-var-message)}]]
(testing (str `test-ns-hook "\n" (symbol v))
;; find ex-info
(let [e (when (-> actual first :type #{:error})
(-> actual first :actual))]
(is (::expected
(some
ex-data
(take-while some? (iterate #(some-> ^Exception % .getCause)
e))))
e))
(is (= expected
(map #(select-keys % [:type :message]) actual))))))))