* Add java.util.Arrays/copyOfRange for slingshot * add exception for tests * Add slingshot tests
This commit is contained in:
Michiel Borkent
GitHub
parent
426e97d1df
commit
15e54ef0a1
6 changed files with 646 additions and 2 deletions
3
deps.edn
3
deps.edn
|
|
@ -78,7 +78,8 @@
|
|||
gaka/gaka {:mvn/version "0.3.0"}
|
||||
failjure/failjure {:mvn/version "2.1.1"}
|
||||
io.helins/binf {:mvn/version "1.1.0-beta0"}
|
||||
rm-hull/jasentaa {:mvn/version "0.2.5"}}
|
||||
rm-hull/jasentaa {:mvn/version "0.2.5"}
|
||||
slingshot/slingshot {:mvn/version "0.12.2"}}
|
||||
:classpath-overrides {org.clojure/clojure nil
|
||||
org.clojure/spec.alpha nil
|
||||
org.clojure/core.specs.alpha nil}}
|
||||
|
|
|
|||
|
|
@ -71,7 +71,8 @@
|
|||
{:name "toString"}
|
||||
{:name "toURI"}]}
|
||||
java.util.Arrays
|
||||
{:methods [{:name "copyOf"}]}
|
||||
{:methods [{:name "copyOf"}
|
||||
{:name "copyOfRange"}]}
|
||||
;; this fixes clojure.lang.Reflector for Java 11
|
||||
java.lang.reflect.AccessibleObject
|
||||
{:methods [{:name "canAccess"}]}}
|
||||
|
|
@ -235,6 +236,7 @@
|
|||
java.time.temporal.Temporal
|
||||
java.time.temporal.TemporalAccessor
|
||||
java.time.temporal.TemporalAdjuster])
|
||||
java.util.concurrent.ExecutionException
|
||||
java.util.concurrent.LinkedBlockingQueue
|
||||
java.util.jar.JarFile
|
||||
java.util.jar.JarEntry
|
||||
|
|
|
|||
|
|
@ -212,6 +212,12 @@
|
|||
'honey.sql.helpers-test
|
||||
'honey.sql.postgres-test)
|
||||
|
||||
(test-namespaces 'slingshot.slingshot-test
|
||||
'slingshot.support-test
|
||||
;; TODO:
|
||||
;; 'slingshot.test-test
|
||||
)
|
||||
|
||||
;;;; final exit code
|
||||
|
||||
(let [{:keys [:test :fail :error] :as m} @status]
|
||||
|
|
|
|||
516
test-resources/lib_tests/slingshot/slingshot_test.clj
Normal file
516
test-resources/lib_tests/slingshot/slingshot_test.clj
Normal file
|
|
@ -0,0 +1,516 @@
|
|||
(ns slingshot.slingshot-test
|
||||
(:require [clojure.test :refer :all]
|
||||
[slingshot.slingshot :refer :all]
|
||||
[clojure.string :as str])
|
||||
(:import java.util.concurrent.ExecutionException))
|
||||
|
||||
(defrecord exception-record [error-code duration-ms message])
|
||||
(defrecord x-failure [message])
|
||||
|
||||
(def a-sphere ^{:type ::sphere} {:radius 3})
|
||||
|
||||
(def h1 (derive (make-hierarchy) ::square ::shape))
|
||||
(def a-square ^{:type ::square} {:size 4})
|
||||
|
||||
(def exception-1 (Exception. "exceptional"))
|
||||
(def exception-record-1 (exception-record. 6 1000 "pdf failure"))
|
||||
|
||||
(defn mult-func [x y]
|
||||
(let [a 7 b 11]
|
||||
(if (= x 3)
|
||||
(* a b x y)
|
||||
(throw+ (x-failure. "x isn't 3... really??")))))
|
||||
|
||||
(defmacro mega-try [body]
|
||||
`(try+
|
||||
~body
|
||||
|
||||
;; by class derived from Throwable
|
||||
(catch IllegalArgumentException e#
|
||||
[:class-iae e#])
|
||||
(catch Exception e#
|
||||
[:class-exception e#])
|
||||
|
||||
;; by java class generically
|
||||
(catch String e#
|
||||
[:class-string e#])
|
||||
|
||||
;; by clojure record type
|
||||
(catch exception-record e#
|
||||
[:class-exception-record e#])
|
||||
|
||||
;; by key-value
|
||||
(catch [:a-key 4] e#
|
||||
[:key-yields-value e#])
|
||||
|
||||
;; by multiple-key-value
|
||||
(catch [:key1 4 :key2 5] e#
|
||||
[:keys-yield-values e#])
|
||||
|
||||
;; by key present
|
||||
(catch (and (set? ~'%) (contains? ~'% :a-key)) e#
|
||||
[:key-is-present e#])
|
||||
|
||||
;; by clojure type, with optional hierarchy
|
||||
(catch (isa? (type ~'%) ::sphere) e#
|
||||
[:type-sphere (type e#) e#])
|
||||
(catch (isa? h1 (type ~'%) ::shape) e#
|
||||
[:type-shape-in-h1 (type e#) e#])
|
||||
|
||||
;; by predicate
|
||||
(catch nil? e#
|
||||
[:pred-nil e#])
|
||||
(catch keyword? e#
|
||||
[:pred-keyword e#])
|
||||
(catch symbol? e#
|
||||
[:pred-symbol e#])
|
||||
(catch map? e#
|
||||
[:pred-map e# (meta e#)])))
|
||||
|
||||
(deftest test-try+
|
||||
(testing "catch by class derived from Throwable"
|
||||
(testing "treat throwables exactly as throw does, interop with try/throw"
|
||||
(is (= [:class-exception exception-1]
|
||||
(mega-try (throw+ exception-1))
|
||||
(mega-try (throw exception-1))
|
||||
(try (throw+ exception-1)
|
||||
(catch Exception e [:class-exception e]))
|
||||
(try (throw exception-1)
|
||||
(catch Exception e [:class-exception e])))))
|
||||
(testing "IllegalArgumentException thrown by clojure/core"
|
||||
(is (= :class-iae (first (mega-try (str/replace "foo" 1 1)))))))
|
||||
|
||||
(testing "catch by java class generically"
|
||||
(is (= [:class-string "fail"] (mega-try (throw+ "fail")))))
|
||||
|
||||
#_(testing "catch by clojure record type"
|
||||
(is (= [:class-exception-record exception-record-1]
|
||||
(mega-try (throw+ exception-record-1)))))
|
||||
|
||||
(testing "catch by key is present"
|
||||
(is (= [:key-is-present #{:a-key}] (mega-try (throw+ #{:a-key})))))
|
||||
|
||||
(testing "catch by keys and values"
|
||||
(is (= [:key-yields-value {:a-key 4}] (mega-try (throw+ {:a-key 4}))))
|
||||
(is (= [:keys-yield-values {:key1 4 :key2 5}]
|
||||
(mega-try (throw+ {:key1 4 :key2 5})))))
|
||||
|
||||
(testing "catch by clojure type with optional hierarchy"
|
||||
(is (= [:type-sphere ::sphere a-sphere] (mega-try (throw+ a-sphere))))
|
||||
(is (= [:type-shape-in-h1 ::square a-square] (mega-try (throw+ a-square)))))
|
||||
|
||||
(testing "catch by predicate"
|
||||
(is (= [:pred-nil nil] (mega-try (throw+ nil))))
|
||||
(is (= [:pred-keyword :awesome] (mega-try (throw+ :awesome))))
|
||||
(is (= [:pred-symbol 'yuletide] (mega-try (throw+ 'yuletide))))
|
||||
(is (= [:pred-map {:error-code 4} nil] (mega-try (throw+ {:error-code 4}))))
|
||||
(testing "preservation of metadata"
|
||||
(is (= [:pred-map {:error-code 4} {:severity 4}]
|
||||
(mega-try (throw+ ^{:severity 4} {:error-code 4})))))))
|
||||
|
||||
(deftest test-clauses
|
||||
(let [bumps (atom 0)
|
||||
bump (fn [] (swap! bumps inc))]
|
||||
(is (nil? (try+)))
|
||||
(is (nil? (try+ (catch integer? i (inc i)))))
|
||||
(is (nil? (try+ (finally (bump)))))
|
||||
(is (nil? (try+ (catch integer? i (inc i)) (finally (bump)))))
|
||||
(is (nil? (try+ (catch integer? i (inc i)) (catch map? m m)
|
||||
(finally (bump)))))
|
||||
|
||||
(is (= 3 (try+ 3)))
|
||||
(is (= 3 (try+ 3 (catch integer? i 4))))
|
||||
(is (= 3 (try+ 3 (finally (bump)))))
|
||||
(is (= 3 (try+ 3 (catch integer? i 4) (finally (bump)))))
|
||||
(is (= 4 (try+ (throw+ 3) (catch integer? i (inc i)) (finally (bump)))))
|
||||
(is (= 4 (try+ (throw+ 3) (catch integer? i (inc i)) (catch map? m m)
|
||||
(finally (bump)))))
|
||||
(is (= 4 (try+ (throw+ {:sel 4}) (catch integer? i (inc i))
|
||||
(catch map? m (:sel m)) (finally (bump)))))
|
||||
|
||||
(is (= 4 (try+ 3 4)))
|
||||
(is (= 4 (try+ 3 4 (catch integer? i 4))))
|
||||
(is (= 4 (try+ 3 4 (finally (bump)))))
|
||||
(is (= 4 (try+ 3 4 (catch integer? i 4) (finally (bump)))))
|
||||
(is (= 5 (try+ (throw+ 4) 4 (catch integer? i (inc i)) (finally (bump)))))
|
||||
(is (= 11 @bumps))))
|
||||
|
||||
(defn ax [] (throw+ 1))
|
||||
(defn bx [] (try+ (ax) (catch integer? p (throw+ 2))))
|
||||
(defn cx [] (try+ (bx) (catch integer? q (throw+ 3))))
|
||||
(defn dx [] (try+ (cx) (catch integer? r (throw+ 4))))
|
||||
(defn ex [] (try+ (dx) (catch integer? s (throw+ 5))))
|
||||
(defn fx [] (try+ (ex) (catch integer? t (throw+ 6))))
|
||||
(defn gx [] (try+ (fx) (catch integer? u (throw+ 7))))
|
||||
(defn hx [] (try+ (gx) (catch integer? v (throw+ 8))))
|
||||
(defn ix [] (try+ (hx) (catch integer? w &throw-context)))
|
||||
|
||||
(defn next-context [x]
|
||||
(-> x :cause get-throw-context))
|
||||
|
||||
(deftest test-throw-context
|
||||
(let [context (ix)
|
||||
context1 (next-context context)
|
||||
context2 (next-context context1)]
|
||||
|
||||
(is (= #{:object :message :cause :stack-trace :wrapper :throwable}
|
||||
(set (keys context))
|
||||
(set (keys context1))
|
||||
(set (keys context2))))
|
||||
(is (= 8 (-> context :object)))
|
||||
(is (= 7 (-> context1 :object)))
|
||||
(is (= 6 (-> context2 :object)))))
|
||||
|
||||
(defn e []
|
||||
(try+
|
||||
(throw (Exception. "uncaught"))
|
||||
(catch integer? i i)))
|
||||
|
||||
(defn f []
|
||||
(try+
|
||||
(throw+ 3.2)
|
||||
(catch integer? i i)))
|
||||
|
||||
|
||||
(defn g []
|
||||
(try+
|
||||
(throw+ 3.2 "wasn't caught")
|
||||
(catch integer? i i)))
|
||||
|
||||
(deftest test-uncaught
|
||||
(is (thrown-with-msg? Exception #"^uncaught$" (e)))
|
||||
(is (thrown-with-msg? Exception #"^throw\+: .*" (f)))
|
||||
(is (thrown-with-msg? Exception #"wasn't caught" (g))))
|
||||
|
||||
(defn h []
|
||||
(try+
|
||||
(try+
|
||||
(throw+ 0)
|
||||
(catch zero? e
|
||||
(throw+)))
|
||||
(catch zero? e
|
||||
:zero)))
|
||||
|
||||
(deftest test-rethrow
|
||||
(is (= :zero (h))))
|
||||
|
||||
(defn i []
|
||||
(try
|
||||
(try+
|
||||
(doall (map (fn [x] (throw+ (str x))) [1]))
|
||||
(catch string? x
|
||||
x))
|
||||
(catch Throwable x)))
|
||||
|
||||
(defn j []
|
||||
(try+
|
||||
(let [fut (future (throw+ "whoops"))]
|
||||
@fut)
|
||||
(catch string? e
|
||||
e)))
|
||||
|
||||
(deftest test-issue-5
|
||||
(is (= "1" (i)))
|
||||
(is (= "whoops" (j))))
|
||||
|
||||
(deftest test-unmacroed-pct
|
||||
(is (= :was-eee (try+ (throw+ "eee")
|
||||
(catch (= % "eee") _ :was-eee)
|
||||
(catch string? _ :no!)))))
|
||||
|
||||
(deftest test-x-ray-vision
|
||||
(let [[val wrapper] (try+
|
||||
(try
|
||||
(try
|
||||
(try
|
||||
(throw+ "x-ray!")
|
||||
(catch Throwable x
|
||||
(throw (RuntimeException. x))))
|
||||
(catch Throwable x
|
||||
(throw (ExecutionException. x))))
|
||||
(catch Throwable x
|
||||
(throw (RuntimeException. x))))
|
||||
(catch string? x
|
||||
[x (:throwable &throw-context)]))]
|
||||
(is (= "x-ray!" val))
|
||||
(is (= "x-ray!" (get-thrown-object wrapper)))))
|
||||
|
||||
(deftest test-catching-wrapper
|
||||
(let [e (Exception.)]
|
||||
(try
|
||||
(try+
|
||||
(throw e)
|
||||
(catch Exception _
|
||||
(throw+ :a "msg: %s" %)))
|
||||
(is false)
|
||||
(catch Exception s
|
||||
(is (= "msg: :a" (.getMessage s)))
|
||||
(is (= e (.getCause s)))))))
|
||||
|
||||
(deftest test-eval-object-once
|
||||
(let [bumps (atom 0)
|
||||
bump (fn [] (swap! bumps inc))]
|
||||
(try+
|
||||
(throw+ (bump) "this is it: %s %s %s" % % %)
|
||||
(catch Object _))
|
||||
(is (= @bumps 1))))
|
||||
|
||||
(deftest test-get-throw-context
|
||||
(let [object (Object.)
|
||||
exception1 (Exception.)
|
||||
exception2 (Exception. "ex1" exception1)
|
||||
t1 (try
|
||||
(throw+ object)
|
||||
(catch Throwable t t))
|
||||
t2 (try
|
||||
(throw+ exception2)
|
||||
(catch Throwable t t))
|
||||
t3 (try
|
||||
(throw exception2)
|
||||
(catch Throwable t t))]
|
||||
(is (= #{:object :message :cause :stack-trace :wrapper
|
||||
:throwable}
|
||||
(-> t1 get-throw-context keys set)))
|
||||
(is (= #{:object :message :cause :stack-trace :throwable}
|
||||
(-> t2 get-throw-context keys set)))
|
||||
(is (= #{:object :message :cause :stack-trace :throwable}
|
||||
(-> t3 get-throw-context keys set)))
|
||||
|
||||
(is (identical? object (:object (get-throw-context t1))))
|
||||
(is (identical? exception2 (:object (get-throw-context t2))))
|
||||
(is (identical? exception2 (:object (get-throw-context t3))))
|
||||
|
||||
(is (identical? exception1 (:cause (get-throw-context t2))))
|
||||
(is (identical? exception1 (:cause (get-throw-context t3))))
|
||||
(is (= "ex1" (:message (get-throw-context t2))))
|
||||
(is (= "ex1" (:message (get-throw-context t3))))))
|
||||
|
||||
(deftest test-get-thrown-object
|
||||
(let [object (Object.)
|
||||
exception (Exception.)
|
||||
t1 (try
|
||||
(throw+ object)
|
||||
(catch Throwable t t))
|
||||
t2 (try
|
||||
(throw+ exception)
|
||||
(catch Throwable t t))
|
||||
t3 (try
|
||||
(throw exception)
|
||||
(catch Throwable t t))]
|
||||
(is (identical? object (get-thrown-object t1)))
|
||||
(is (identical? exception (get-thrown-object t2)))
|
||||
(is (identical? exception (get-thrown-object t3)))))
|
||||
|
||||
(deftest test-wrapper-and-throwable
|
||||
(let [context (try+
|
||||
(try
|
||||
(throw+ :afp "wrapper-0")
|
||||
(catch Exception e
|
||||
(throw (RuntimeException. "wrapper-1" e))))
|
||||
(catch Object _
|
||||
&throw-context))]
|
||||
(is (= "wrapper-0" (.getMessage ^Throwable (:wrapper context))))
|
||||
(is (= "wrapper-1" (.getMessage ^Throwable (:throwable context))))))
|
||||
|
||||
(deftest test-inline-predicate
|
||||
(is (= :not-caught (try+
|
||||
(throw+ {:foo true})
|
||||
(catch #(-> % :foo (= false)) data
|
||||
:caught)
|
||||
(catch Object _
|
||||
:not-caught)))))
|
||||
|
||||
(defn gen-body
|
||||
[rec-sym throw?]
|
||||
(let [body `(swap! ~rec-sym #(conj % :body))]
|
||||
(if throw?
|
||||
(list 'do body `(throw+ (Exception.)))
|
||||
body)))
|
||||
|
||||
(defn gen-catch-clause
|
||||
[rec-sym]
|
||||
`(catch Exception e# (swap! ~rec-sym #(conj % :catch))))
|
||||
|
||||
(defn gen-else-clause
|
||||
[rec-sym broken?]
|
||||
(let [else-body `(swap! ~rec-sym #(conj % :else))]
|
||||
(if broken?
|
||||
(list 'else (list 'do else-body `(throw+ (Exception.))))
|
||||
(list 'else else-body))))
|
||||
|
||||
(defn gen-finally-clause
|
||||
[rec-sym]
|
||||
`(finally (swap! ~rec-sym #(conj % :finally))))
|
||||
|
||||
(defn gen-try-else-form
|
||||
"Generate variations of (try ... (else ...) ...) forms, which (when eval'd)
|
||||
will return a vector describing the sequence in which things were evaluated,
|
||||
e.g. [:body :catch :finally]"
|
||||
[throw? catch? finally? broken-else?]
|
||||
(let [rec-sym (gensym "rec")
|
||||
body (gen-body rec-sym throw?)
|
||||
catch-clause (if catch? (gen-catch-clause rec-sym))
|
||||
else-clause (gen-else-clause rec-sym broken-else?)
|
||||
finally-clause (if finally? (gen-finally-clause rec-sym))]
|
||||
`(let [~rec-sym (atom [])]
|
||||
(try+
|
||||
~(remove nil? `(try+
|
||||
~body
|
||||
~catch-clause
|
||||
~else-clause
|
||||
~finally-clause))
|
||||
(catch Object e#
|
||||
;; if the inner try+ threw, report it as a :bang! in the return vec
|
||||
(swap! ~rec-sym #(conj % :bang!))))
|
||||
@~rec-sym)))
|
||||
|
||||
(deftest test-else
|
||||
(doseq [throw? [true false]
|
||||
catch? [true false]
|
||||
broken-else? [true false]
|
||||
finally? [true false]]
|
||||
(testing (str "test-else: throw? " throw? " catch? " catch?
|
||||
" broken-else? " broken-else? " finally? " finally?)
|
||||
(let [try-else-form (gen-try-else-form throw? catch? finally? broken-else?)
|
||||
actual (eval try-else-form)
|
||||
expected (vec (remove nil?
|
||||
[:body
|
||||
(if (and throw? catch?) :catch)
|
||||
(if (not throw?) :else)
|
||||
(if finally? :finally)
|
||||
;; expect an escaped exception when either:
|
||||
;; a) the else clause runs, and throws
|
||||
;; b) the body throws, and is not caught
|
||||
(if (or (and (not throw?) broken-else?)
|
||||
(and throw? (not catch?))) :bang!)]))]
|
||||
(is (= actual expected))))))
|
||||
|
||||
(deftest test-reflection
|
||||
(try+
|
||||
nil
|
||||
(catch Exception e
|
||||
(.getMessage e))))
|
||||
|
||||
(deftest test-ex-info-compatibility
|
||||
(let [data {:type :fail :reason :not-found}
|
||||
message "oops"
|
||||
wrapper (ex-info message data)
|
||||
rte1 (RuntimeException. "one" wrapper)
|
||||
rte2 (RuntimeException. "two" rte1)
|
||||
direct (try+
|
||||
(throw wrapper)
|
||||
(catch [:type :fail] e
|
||||
&throw-context)
|
||||
(catch Object _
|
||||
:whoops))
|
||||
cause-chain (try+
|
||||
(throw rte2)
|
||||
(catch [:type :fail] e
|
||||
&throw-context)
|
||||
(catch Object _
|
||||
:whoops))]
|
||||
(is (= (:object direct) data))
|
||||
(is (= (:object cause-chain) data))
|
||||
(is (= (:message direct) message))
|
||||
(is (= (:message cause-chain) message))
|
||||
(is (= (:wrapper direct) wrapper))
|
||||
(is (= (:wrapper cause-chain) wrapper))
|
||||
(is (= (:throwable direct) wrapper))
|
||||
(is (= (:throwable cause-chain) rte2))))
|
||||
|
||||
;; helpers for test-optional-cause
|
||||
|
||||
(defmacro caught-result [& body]
|
||||
`(try+
|
||||
~@body
|
||||
(catch Object ~'o
|
||||
[(:cause ~'&throw-context)
|
||||
(:message ~'&throw-context)])))
|
||||
|
||||
(defmacro caught-result-from-catch [cause & body]
|
||||
`(caught-result
|
||||
(try+
|
||||
(throw+ ~cause)
|
||||
(catch Object ~'o
|
||||
~@body))))
|
||||
|
||||
(deftest test-optional-cause
|
||||
(let [imp (Exception. "I did it implicitly.")
|
||||
exp (Exception. "I did it explicitly.")
|
||||
def-msg "throw+: 1"
|
||||
msg "message two %s"
|
||||
fmt "aha! %s"
|
||||
fmt-msg "aha! 1"
|
||||
fmt2 "%s leading to %s"
|
||||
fmt2-msg "1 leading to [1 1]"
|
||||
|
||||
;; throw from outside catch, no implicit cause
|
||||
|
||||
result1 (caught-result (throw+ 1))
|
||||
result2 (caught-result (throw+ 1 msg))
|
||||
result3 (caught-result (throw+ 1 fmt %))
|
||||
result4 (caught-result (throw+ 1 fmt2 % [% %]))
|
||||
|
||||
result5 (caught-result (throw+ 1 nil))
|
||||
result6 (caught-result (throw+ 1 nil msg))
|
||||
result7 (caught-result (throw+ 1 nil fmt %))
|
||||
result8 (caught-result (throw+ 1 nil fmt2 % [% %]))
|
||||
|
||||
result9 (caught-result (throw+ 1 exp))
|
||||
result10 (caught-result (throw+ 1 exp msg))
|
||||
result11 (caught-result (throw+ 1 exp fmt %))
|
||||
result12 (caught-result (throw+ 1 exp fmt2 % [% %]))
|
||||
|
||||
;; throw from inside catch, implicit cause available
|
||||
|
||||
result13 (caught-result-from-catch imp (throw+))
|
||||
|
||||
result14 (caught-result-from-catch imp (throw+ 1))
|
||||
result15 (caught-result-from-catch imp (throw+ 1 msg))
|
||||
result16 (caught-result-from-catch imp (throw+ 1 fmt %))
|
||||
result17 (caught-result-from-catch imp (throw+ 1 fmt2 % [% %]))
|
||||
|
||||
result18 (caught-result-from-catch imp (throw+ 1 nil))
|
||||
result19 (caught-result-from-catch imp (throw+ 1 nil msg))
|
||||
result20 (caught-result-from-catch imp (throw+ 1 nil fmt %))
|
||||
result21 (caught-result-from-catch imp (throw+ 1 nil fmt2 % [% %]))
|
||||
|
||||
result22 (caught-result-from-catch imp (throw+ 1 exp))
|
||||
result23 (caught-result-from-catch imp (throw+ 1 exp msg))
|
||||
result24 (caught-result-from-catch imp (throw+ 1 exp fmt %))
|
||||
result25 (caught-result-from-catch imp (throw+ 1 exp fmt2 % [% %]))]
|
||||
|
||||
(testing "outside catch"
|
||||
(testing "implicit cause"
|
||||
(is (= result1 [nil def-msg]))
|
||||
(is (= result2 [nil msg]))
|
||||
(is (= result3 [nil fmt-msg]))
|
||||
(is (= result4 [nil fmt2-msg])))
|
||||
(testing "erased cause"
|
||||
(is (= result5 [nil def-msg]))
|
||||
(is (= result6 [nil msg]))
|
||||
(is (= result7 [nil fmt-msg]))
|
||||
(is (= result8 [nil fmt2-msg])))
|
||||
(testing "explicit cause"
|
||||
(is (= result9 [exp def-msg]))
|
||||
(is (= result10 [exp msg]))
|
||||
(is (= result11 [exp fmt-msg]))
|
||||
(is (= result12 [exp fmt2-msg]))))
|
||||
(testing "inside catch"
|
||||
(testing "rethrow"
|
||||
(is (= result13 [nil "I did it implicitly."])))
|
||||
(testing "implicit cause"
|
||||
(is (= result14 [imp def-msg]))
|
||||
(is (= result15 [imp msg]))
|
||||
(is (= result16 [imp fmt-msg]))
|
||||
(is (= result17 [imp fmt2-msg])))
|
||||
(testing "erased cause"
|
||||
(is (= result18 [nil def-msg]))
|
||||
(is (= result19 [nil msg]))
|
||||
(is (= result20 [nil fmt-msg]))
|
||||
(is (= result21 [nil fmt2-msg])))
|
||||
(testing "explicit cause"
|
||||
(is (= result22 [exp def-msg]))
|
||||
(is (= result23 [exp msg]))
|
||||
(is (= result24 [exp fmt-msg]))
|
||||
(is (= result25 [exp fmt2-msg]))))))
|
||||
111
test-resources/lib_tests/slingshot/support_test.clj
Normal file
111
test-resources/lib_tests/slingshot/support_test.clj
Normal file
|
|
@ -0,0 +1,111 @@
|
|||
(ns slingshot.support-test
|
||||
(:require [clojure.test :refer :all]
|
||||
[slingshot.slingshot :refer [throw+ try+]]
|
||||
[slingshot.support :refer :all])
|
||||
(:import (java.util.concurrent ExecutionException)))
|
||||
|
||||
(deftest test-parse-try+
|
||||
(let [f parse-try+]
|
||||
(is (= [nil nil nil nil] (f ())))
|
||||
|
||||
(is (= ['(1) nil nil nil] (f '(1))))
|
||||
(is (= [nil '((catch 1)) nil nil] (f '((catch 1)))))
|
||||
(is (= [nil nil '(else 1) nil] (f '((else 1)))))
|
||||
(is (= [nil nil nil '(finally 1)] (f '((finally 1)))))
|
||||
|
||||
(is (= ['(1) '((catch 1)) nil nil] (f '(1 (catch 1)))))
|
||||
(is (= ['(1) nil '(else 1) nil] (f '(1 (else 1)))))
|
||||
(is (= ['(1) nil nil '(finally 1)] (f '(1 (finally 1)))))
|
||||
|
||||
(is (= ['(1) '((catch 1)) nil '(finally 1)]
|
||||
(f '(1 (catch 1) (finally 1)))))
|
||||
(is (= ['(1) '((catch 1) (catch 2)) nil '(finally 1)]
|
||||
(f '(1 (catch 1) (catch 2) (finally 1)))))
|
||||
(is (= ['(1) '((catch 1)) '(else 1) nil]
|
||||
(f '(1 (catch 1) (else 1)))))
|
||||
(is (= ['(1) '((catch 1) (catch 2)) '(else 1) nil]
|
||||
(f '(1 (catch 1) (catch 2) (else 1)))))
|
||||
|
||||
(is (= [nil nil '(else 1) '(finally 1)]
|
||||
(f '((else 1) (finally 1)))))
|
||||
(is (= ['(1) nil '(else 1) '(finally 1)]
|
||||
(f '(1 (else 1) (finally 1)))))
|
||||
(is (= [nil '((catch 1)) '(else 1) nil]
|
||||
(f '((catch 1) (else 1)))))
|
||||
(is (= ['(1) '((catch 1)) '(else 1) nil]
|
||||
(f '(1 (catch 1) (else 1)))))
|
||||
|
||||
(is (thrown? IllegalArgumentException (f '((catch 1) (1)))))
|
||||
(is (thrown? IllegalArgumentException (f '((finally 1) (1)))))
|
||||
(is (thrown? IllegalArgumentException (f '((finally 1) (catch 1)))))
|
||||
(is (thrown? IllegalArgumentException (f '((finally 1) (finally 2)))))
|
||||
(is (thrown? IllegalArgumentException (f '((else 1) (1)))))
|
||||
(is (thrown? IllegalArgumentException (f '((else 1) (catch 1)))))
|
||||
(is (thrown? IllegalArgumentException (f '((else 1) (else 2)))))))
|
||||
|
||||
(defn stack-trace-fn []
|
||||
(stack-trace))
|
||||
|
||||
#_(deftest test-stack-trace
|
||||
(let [{:keys [methodName className]} (-> (stack-trace-fn) first bean)]
|
||||
(is (= methodName "invoke"))
|
||||
(is (re-find #"stack_trace_fn" className))))
|
||||
|
||||
(deftest test-resolve-local
|
||||
(let [a 4]
|
||||
(is (= 4 (resolve-local a)))
|
||||
(is (nil? (resolve-local b)))))
|
||||
|
||||
(deftest test-wrap
|
||||
(let [tmessage "test-wrap-1"
|
||||
tobject 4
|
||||
tcause (Exception.)
|
||||
tstack-trace (stack-trace)
|
||||
tdata {:object tobject}
|
||||
tcontext (assoc tdata
|
||||
:message tmessage
|
||||
:cause tcause
|
||||
:stack-trace tstack-trace)
|
||||
tthrowable (wrap tcontext)
|
||||
{:keys [message cause data stackTrace]} (bean tthrowable)]
|
||||
(is (ex-data tthrowable))
|
||||
(is (= [message cause (seq stackTrace) data]
|
||||
[tmessage tcause (seq tstack-trace) tdata]))))
|
||||
|
||||
(def test-hooked (atom nil))
|
||||
|
||||
(deftest test-throw-hook
|
||||
(binding [*throw-hook* #(reset! test-hooked %)]
|
||||
(throw+ "throw-hook-string")
|
||||
(is (= (set (keys @test-hooked))
|
||||
(set [:object :message :cause :stack-trace])))
|
||||
(is (= "throw-hook-string" (:object @test-hooked))))
|
||||
(binding [*throw-hook* (fn [x] 42)]
|
||||
(is (= (throw+ "something") 42))))
|
||||
|
||||
(def catch-hooked (atom nil))
|
||||
|
||||
(defn catch-hook-return [object]
|
||||
(fn [x] (assoc x :catch-hook-return object)))
|
||||
|
||||
(defn catch-hook-throw [object]
|
||||
(fn [x] (assoc x :catch-hook-throw object)))
|
||||
|
||||
(deftest test-catch-hook
|
||||
(binding [*catch-hook* #(reset! catch-hooked %)]
|
||||
(try+ (throw+ "catch-hook-string") (catch string? x x))
|
||||
(is (= (set (keys @catch-hooked))
|
||||
(set [:object :message :cause :stack-trace :wrapper :throwable])))
|
||||
(is (= "catch-hook-string" (:object @catch-hooked))))
|
||||
(binding [*catch-hook* (catch-hook-return 42)]
|
||||
(is (= 42 (try+ (throw+ "boo") (catch string? x x)))))
|
||||
(binding [*catch-hook* (catch-hook-throw (IllegalArgumentException. "bleh"))]
|
||||
(is (thrown-with-msg? IllegalArgumentException #"bleh"
|
||||
(try+ (throw+ "boo") (catch string? x x)))))
|
||||
(is (= "soup!"
|
||||
(try+
|
||||
(binding [*catch-hook* (catch-hook-throw "soup!")]
|
||||
(try+
|
||||
(throw+ "boo")
|
||||
(catch string? x x)))
|
||||
(catch string? x x)))))
|
||||
8
test-resources/lib_tests/slingshot/test_test.clj
Normal file
8
test-resources/lib_tests/slingshot/test_test.clj
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
(ns slingshot.test-test
|
||||
(:require [clojure.test :refer :all]
|
||||
[slingshot.slingshot :refer [throw+]]
|
||||
[slingshot.test]))
|
||||
|
||||
(deftest test-slingshot-test-macros
|
||||
(is (thrown+? string? (throw+ "test")))
|
||||
(is (thrown+-with-msg? string? #"th" (throw+ "test" "hi there"))))
|
||||
Loading…
Reference in a new issue