pax_global_header00006660000000000000000000000064124660110310014504gustar00rootroot0000000000000052 comment=5125a79e2bd6b25384f41e2751608d9e2ee1580b slingshot-0.12.2/000077500000000000000000000000001246601103100136005ustar00rootroot00000000000000slingshot-0.12.2/.gitignore000066400000000000000000000001241246601103100155650ustar00rootroot00000000000000/target /classes /checkouts pom.xml pom.xml.asc *.jar *.class /.lein-* /.nrepl-port slingshot-0.12.2/.travis.yml000066400000000000000000000001111246601103100157020ustar00rootroot00000000000000language: clojure jdk: - openjdk7 - oraclejdk7 script: lein all test slingshot-0.12.2/CHANGES000066400000000000000000000074221246601103100146000ustar00rootroot00000000000000* version 0.7.0 - throw+: specify message as fmt & args rather than a single string - can use % in args (at any depth) to represent the thrown object - support: move small helper functions into letfns * version 0.7.1 - throw+: fix so that the thrown object is only eval'd once * version 0.7.2 - throw+: introduce &thrown-object to allow both single-evaluation of object and deep substitution of % simultaneously * version 0.8.0 - breaking change: slingshot.core -> slingshot.slingshot - remove &thrown-object in favor of a gensym. (the user will never need to refer to it) - simplify/clarify support functions * version 0.9.0 - retire :wrapper and move :throwable to the context proper - stop using metadata on the context - provide an example in README.md - doc string fixes - change so catch hook always runs even when there are no catch clauses - provide slingshot/get-thrown-object to retrieve the object thrown by throw or throw+ given a Throwable caught within an ordinary try form. * version 0.10.0 - add get-throw-context and reimplement get-thrown-object using it - get-thrown-object will now find stones in cause chains like try+/catch does - clients looking for a uniform map-based interface to reading the object, message, cause, and stack traces of objects thrown by throw or throw+ now have it - shortened default message to "throw+: %s" - reorganize support namespace: context section - remove references to Stone in docs, replace with wrapper - slingshot.Stone -> slingshot.ExceptionInfo - named after similar new class in clojure.lang in 1.4 - no longer redundantly stores message, cause, and stack-trace in the payload of ExceptionInfo--now stored only in the like-named member variables - reduced reflection warnings - doc update including moving description of throw context to get-throw context - provide the immediate object wrapper at :wrapper in the context (accessible via get-throw-context or in &throw-context) - use clojure.core's ex-data and ex-info if available, but don't depend on them * version 0.10.1 - fix slingshot version in examples to match release - remove reflection warnings from tests and turn on checking in project.clj [resolves issue 18] * version 0.10.2 - accept a simple string as a message for throw+ (issue 19) - for catch, only interpret a form as a selector if it contains a % symbol, allows function literals for predicates (issue 20) * version 0.10.3 - make exception class available from support and add clojure.test support for testing that the proper exception is thrown (issue 21) - remove replace-all and % substitution in source in favor of using let to bind % (issue 22) - key-value pair -> key-values, generalize key-value selector to allow any even number of items in the vector (issue 23) * version 0.11.0 - add :else option for try+ (issue 34) - improve catch by class to avoid reflection (issue 37) - dropped custom ex-info, ex-data, ex-class and other support for Clojure 1.3.0 - modernized project.clj - signed artifacts for clojars * version 0.12.0 - new optional argument to throw+ allows specifying a Throwable as the cause explicitly - explicit cause overrides the captured cause in a catch - issue 29 - now treats all IExceptionInfo objects as data wrappers - catch selectors refer to the map passed in to `ex-info` - issue 35 - no longer provides :environment in &throw-context - now compatible with locals clearing - issue 36 * version 0.12.1 - internal improvements - documentation updates for correctness, clarity * version 0.12.2 - improved interop with ex-info/ex-data - throw+ explicit cause can be nil - tests for more throw+ arguments - started travis-ci builds slingshot-0.12.2/README.md000066400000000000000000000137751246601103100150740ustar00rootroot00000000000000[![Build Status](https://travis-ci.org/scgilardi/slingshot.svg?branch=master)](https://travis-ci.org/scgilardi/slingshot) [![Dependency Status](https://www.versioneye.com/user/projects/54d57a7b3ca0840b1900063a/badge.svg?style=flat)](https://www.versioneye.com/user/projects/54d57a7b3ca0840b1900063a) slingshot ========= Enhanced throw and catch for Clojure ------------------------------------ Provides `try+` and `throw+`. Each is 100% compatible with Clojure and Java's native `try` and `throw` both in source code and at runtime. Each also provides additional capabilities intended to improve ease of use by leveraging Clojure's features like maps, records, and destructuring. Clojure's native `try` and `throw` behave much like those of Java: throw can accept objects derived from java.lang.Throwable and `try` selects from among catch clauses based on the class of the thrown object. In addition to fully supporting those uses (whether they originate from Clojure code or from Java code via interop), `try+` and `throw+` provide these enhanced capabilities: - `throw+` can throw any Java object, not just those whose class is derived from `java.lang.Throwable`. Clojure maps or records become an easy way to represent custom exceptions without requiring `gen-class`. - `catch` clauses within `try+` can catch: - any Java object thrown by `throw+`, - any map passed to `ex-info` and thrown by `throw` or `throw+`, or - any `Throwable` thrown by Clojure's `throw`, or Java's `throw`. The first catch clause whose **selector** matches the thrown object will execute. a selector can be: - a **class name**: (e.g., `RuntimeException`, `my.clojure.record`), matches any instance of that class, or - a **key-values** vector: (e.g., `[key val & kvs]`), matches objects where `(and (= (get object key) val) ...)`, or - a **predicate**: (function of one argument like `map?`, `set?`), matches any Object for which the predicate returns a truthy value, or - a **selector form**: a form containing one or more instances of `%` to be replaced by the thrown object, matches any object for which the form evaluates to truthy. - the class name, key-values, and predicate selectors are shorthand for these selector forms: ` => (instance? %)` `[ & ] => (and (= (get % ) ) ...)` ` => ( %)` - the binding to the caught exception in a catch clause is not required to be a simple symbol. It is subject to destructuring so the body of the catch clause can use the contents of a thrown collection easily. - in a catch clause, the context at the throw site is accessible via the hidden argument `&throw-context`. - `&throw-context` is a map containing: for Throwable caught objects: :object the caught object; :message the message, from .getMessage; :cause the cause, from .getCause; :stack-trace the stack trace, from .getStackTrace; :throwable the caught object; for non-Throwable caught objects (including maps passed to ex-info) :object the caught object; :message the message, from throw+ or ex-info; :cause the cause, from throw+ or ex-info, see below; :stack-trace the stack trace, captured by throw+ or ex-info; :wrapper the Throwable wrapper that carried the object; :throwable the outermost Throwable whose cause chain contains the wrapper, see below. To throw a non-`Throwable` object, `throw+` wraps it in a `Throwable` wrapper by calling `ex-info`. Every instance of `IExceptionInfo` (whether generated by throw+ or by a direct call to `ex-info`) is treated as a wrapper. The wrapper is available via the `:wrapper` key in `&throw-context`. Between being thrown and caught, a wrapper may be further wrapped by other Exceptions (e.g., instances of `RuntimeException` or `java.util.concurrent.ExecutionException`). `try+` sees through all such wrappers to find the thrown object. The outermost wrapper is available within a catch clause a via the `:throwable` key in `&throw-context`. When `throw+` throws a non-`Throwable` object from within a `try+` catch clause, the outermost wrapper of the caught object being processed is captured as the cause of the new `throw+`. This can be overridden by providing an explicit `cause` argument to `throw+`. - an optional `else` clause may appear after all `catch` clauses and before any `finally` clause. Its contents will be executed (for side effects) immediately after the code in the `try+` body completes only if nothing was thrown. Usage ----- project.clj [![Clojars Project](http://clojars.org/slingshot/latest-version.svg)](http://clojars.org/slingshot) tensor/parse.clj ```clojure (ns tensor.parse (:use [slingshot.slingshot :only [throw+]])) (defn parse-tree [tree hint] (if (bad-tree? tree) (throw+ {:type ::bad-tree :tree tree :hint hint}) (parse-good-tree tree hint))) ``` math/expression.clj ```clojure (ns math.expression (:require [tensor.parse] [clojure.tools.logging :as log]) (:use [slingshot.slingshot :only [throw+ try+]])) (defn read-file [file] (try+ [...] (tensor.parse/parse-tree tree) [...] (catch [:type :tensor.parse/bad-tree] {:keys [tree hint]} (log/error "failed to parse tensor" tree "with hint" hint) (throw+)) (catch Object _ (log/error (:throwable &throw-context) "unexpected error") (throw+)))) ``` Credits ------- Based on clojure.contrib.condition, data-conveying-exception, discussions on the clojure mailing list and wiki and discussions and implementations by Steve Gilardi, Phil Hagelberg, and Kevin Downey. License ------- Copyright © 2011-2014 Stephen C. Gilardi, Kevin Downey, and Phil Hagelberg Distributed under the Eclipse Public License, the same as Clojure. slingshot-0.12.2/project.clj000066400000000000000000000014171246601103100157430ustar00rootroot00000000000000(defproject slingshot "0.12.2" :description "Enhanced throw, try, leveraging Clojure's capabilities" :url "https://github.com/scgilardi/slingshot" :license {:name "Eclipse Public License 1.0" :url "https://www.eclipse.org/legal/epl-v10.html" :distribution :repo} :deploy-repositories [["releases" :clojars]] :global-vars {*warn-on-reflection* true} :profiles {:dev {:dependencies [[org.clojure/clojure "1.7.0-alpha5"]]} :1.4 {:dependencies [[org.clojure/clojure "1.4.0"]]} :1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]} :1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]} :1.7 {:dependencies [[org.clojure/clojure "1.7.0-alpha5"]]}} :aliases {"all" ["with-profile" "1.4:1.5:1.6:1.7"]}) slingshot-0.12.2/src/000077500000000000000000000000001246601103100143675ustar00rootroot00000000000000slingshot-0.12.2/src/slingshot/000077500000000000000000000000001246601103100164015ustar00rootroot00000000000000slingshot-0.12.2/src/slingshot/slingshot.clj000066400000000000000000000125361246601103100211140ustar00rootroot00000000000000(ns slingshot.slingshot (:require [slingshot.support :as s])) (defmacro try+ "Like the try special form, but with enhanced catch clauses and an optional else clause: - catch non-Throwable objects thrown by throw+ or data made throwable by ex-info as well as Throwable objects thrown by throw or throw+; - specify objects to catch by class name, key-values, predicate, or arbitrary selector form; - destructure the caught object; - an optional else clause may appear after all catch clauses and before any finally clause. Its contents will be executed (for side effects) immediately after the code in the try+ body completes only if nothing was thrown. A selector form is a form containing one or more instances of % to be replaced by the thrown object. If it evaluates to truthy, the object is caught. The class name, key-values, and predicate selectors are shorthand for these selector forms: => (instance? %) [ & ] => (and (= (get % ) ) ...) => ( %) The binding form in a try+ catch clause is not required to be a simple symbol. It is subject to destructuring which allows easy access to the contents of a thrown collection. The local &throw-context is available within try+ catch clauses, bound to the throw context for the caught object. See also: throw+, get-throw-context" [& body] (let [[expressions catches else finally] (s/parse-try+ body) threw? (gensym "threw?")] `(let [~threw? (atom false)] (try ~@expressions ~@(s/gen-catch catches `throw+ threw?) ~@(s/gen-finally else finally threw?))))) (defmacro throw+ "Like the throw special form, but can throw any object by wrapping non-Throwable objects in a Throwable wrapper. throw+ has the same syntax and behavior as throw for Throwable objects. The message, cause, and stack trace are those carried by the Throwable. For non-Throwable objects, the message and cause have default values which can be overridden by optional arguments: (throw+ object cause? message-or-fmt? & fmt-args) - object: required, the object to throw - cause: optional, a Throwable, the default is: - within a try+ catch clause, the the outermost wrapper of the caught object being processed, - elsewhere, nil. - message: optional, specified either as a string or a format string and args for clojure.core/format: - % symbols anywhere within args name the thrown object - the default is: \"throw+: %s\" (pr-str %) The stack trace is that of the current thread at the time of the throw+ call, starting at the function that encloses it; Within a try+ catch clause, a throw+ call with no arguments rethrows the caught object within its original (possibly nested) wrappers. See also try+, get-throw-context" {:arglists '([] [object cause? message-or-fmt? & fmt-args])} ([object & args] `(let [~'% ~object] (s/throw-fn ~'% (s/resolve-local ~'&throw-context) (s/stack-trace) ~@args))) ([] `(s/rethrow))) (defn get-throw-context "Returns the throw context for an object thrown by throw or throw+ given a Throwable t. Allows callers to access information about any thrown object as a Clojure map. If t or any Throwable in its cause chain wraps a non-Throwable object thrown by throw+ or data made throwable by ex-info, returns the associated context with t assoc'd as the value for :throwable, and the wrapper assoc'd as the value for :wrapper, else returns a new context based on t. Within a try+ catch clause, prefer using the &throw-context local to calling get-throw-context explicitly. A throw context is a map containing: - for Throwable objects: :object the object; :message the message, from .getMessage; :cause the cause, from .getCause; :stack-trace the stack trace, from .getStackTrace; :throwable the object; - for non-Throwable objects (including data made throwable by ex-info): :object the object; :message the message, see throw+, ex-info; :cause the cause, see throw+, ex-info; :stack-trace the stack trace, see throw+, ex-info; :wrapper the Throwable wrapper that carried the object, see below; :throwable the outermost Throwable whose cause chain contains the wrapper, see below; To throw a non-Throwable object, throw+ or ex-info wraps it in a Throwable wrapper. The wrapper is available via the :wrapper key in the throw context. Between being thrown and caught, the wrapper may be wrapped by other exceptions (e.g., instances of RuntimeException or java.util.concurrent.ExecutionException). get-throw-context searches all nested wrappers to find the thrown object. The outermost wrapper is available via the :throwable key in the throw context. See also try+" [t] (s/get-context t)) (defn get-thrown-object "Returns the object thrown by throw or throw+ given a Throwable. Useful for processing a Throwable outside of a try+ form when the source of the Throwable may or may not have been throw+ or ex-info. See also get-throw-context" [t] (-> t get-throw-context :object)) slingshot-0.12.2/src/slingshot/support.clj000066400000000000000000000211261246601103100206110ustar00rootroot00000000000000(ns slingshot.support (:require [clojure.walk])) (defn appears-within? "Returns true if x appears within coll at any nesting depth" [x coll] (let [result (atom false)] (clojure.walk/postwalk (fn [t] (when (= x t) (reset! result true))) coll) @result)) (defn throw-arg "Throws an IllegalArgumentException with a message given arguments for clojure.core/format" [fmt & args] (throw (IllegalArgumentException. ^String (apply format fmt args)))) ;; context support (defn make-context "Makes a throw context from a throwable or explicit arguments" ([^Throwable t] (make-context t (.getMessage t) (.getCause t) (.getStackTrace t))) ([object message cause stack-trace] {:object object :message message :cause cause :stack-trace stack-trace})) (defn wrap "Returns a context wrapper given a context" [{:keys [object message cause stack-trace]}] (let [data (if (map? object) object ^::wrapper? {:object object})] (doto ^Throwable (ex-info message data cause) (.setStackTrace stack-trace)))) (defn unwrap "If t is a context wrapper or other IExceptionInfo, returns the corresponding context with t assoc'd as the value for :wrapper, else returns nil" [^Throwable t] (if-let [data (ex-data t)] (assoc (make-context t) :object (if (::wrapper? (meta data)) (:object data) data) :wrapper t))) (defn unwrap-all "Searches Throwable t and its cause chain for a context wrapper or other IExceptionInfo. If one is found, returns the corresponding context with the wrapper assoc'd as the value for :wrapper, else returns nil." [^Throwable t] (or (unwrap t) (if-let [cause (.getCause t)] (recur cause)))) (defn get-throwable "Returns a Throwable given a context: the object in context if it's a Throwable, else a Throwable context wrapper" [{object :object :as context}] (if (instance? Throwable object) object (wrap context))) (defn get-context "Returns a context given a Throwable t. If t or any Throwable in its cause chain is a context wrapper or other IExceptionInfo, returns the corresponding context with the wrapper assoc'd as the value for :wrapper and t assoc'd as the value for :throwable. Otherwise creates a new context based on t with t assoc'd as the value for :throwable." [^Throwable t] (-> (or (unwrap-all t) (make-context t)) (assoc :throwable t))) ;; try+ support (defn parse-try+ "Returns a vector of seqs containing the expressions, catch clauses, and finally clauses in a try+ body, or throws if the body's structure is invalid" [body] (letfn [(item-type [item] ({'catch :catch-clause 'else :else-clause 'finally :finally-clause} (and (seq? item) (first item)) :expression)) (match-or-defer [s type] (if (-> s ffirst item-type (= type)) s (cons nil s)))] (let [groups (partition-by item-type body) [e & groups] (match-or-defer groups :expression) [c & groups] (match-or-defer groups :catch-clause) [l & groups] (match-or-defer groups :else-clause) [f & groups] (match-or-defer groups :finally-clause)] (if (every? nil? [groups (next l) (next f)]) [e c (first l) (first f)] (throw-arg "try+ form must match: (%s %s)" "try+ expression* catch-clause*" "else-clause? finally-clause?"))))) (def ^{:dynamic true :doc "Hook to allow overriding the behavior of catch. Must be bound to a function of one argument, a context map. Returns a (possibly modified) context map to be considered by catch clauses. Normal processing by catch clauses can be skipped by adding special keys to the context map: If the context contains the key: - :catch-hook-return, try+ will return the corresponding value; - :catch-hook-throw, try+ will throw+ the corresponding value; - :catch-hook-rethrow, try+ will rethrow the caught object's outermost wrapper. Defaults to identity."} *catch-hook* identity) (defn gen-catch "Transforms a seq of catch clauses for try+ into a list containing one catch clause for try that implements the specified behavior. throw-sym names a macro or function (usually throw+) that can accept zero or one arguments. It is called with one argument for :catch-hook-throw requests, or zero arguments for :catch-hook-rethrow requests or when no try+ catch clause matches." [catch-clauses throw-sym threw?-sym] (letfn [(class-selector? [selector] (if (symbol? selector) (let [resolved (resolve selector)] (if (class? resolved) resolved)))) (cond-test [selector] (letfn [(key-values [] (and (vector? selector) (if (even? (count selector)) `(and ~@(for [[key val] (partition 2 selector)] `(= (get ~'% ~key) ~val))) (throw-arg "key-values selector: %s does not match: %s" (pr-str selector) "[key val & kvs]")))) (selector-form [] (and (seq? selector) (appears-within? '% selector) selector)) (predicate [] `(~selector ~'%))] `(let [~'% (:object ~'&throw-context)] ~(or (key-values) (selector-form) (predicate))))) (cond-expression [binding-form expressions] `(let [~binding-form (:object ~'&throw-context)] ~@expressions)) (transform [[_ selector binding-form & expressions]] (if-let [class-selector (class-selector? selector)] [`(instance? ~class-selector (:object ~'&throw-context)) (cond-expression (with-meta binding-form {:tag selector}) expressions)] [(cond-test selector) (cond-expression binding-form expressions)]))] (list `(catch Throwable ~'&throw-context (reset! ~threw?-sym true) (let [~'&throw-context (-> ~'&throw-context get-context *catch-hook*)] (cond (contains? ~'&throw-context :catch-hook-return) (:catch-hook-return ~'&throw-context) (contains? ~'&throw-context :catch-hook-throw) (~throw-sym (:catch-hook-throw ~'&throw-context)) (contains? ~'&throw-context :catch-hook-rethrow) (~throw-sym) ~@(mapcat transform catch-clauses) :else (~throw-sym))))))) (defn gen-finally "Returns either nil or a list containing a finally clause for a try form based on the parsed else and/or finally clause from a try+ form" [else-clause finally-clause threw?-sym] (cond else-clause (list `(finally (try (when-not @~threw?-sym ~@(rest else-clause)) ~(if finally-clause finally-clause)))) finally-clause (list finally-clause))) ;; throw+ support (defmacro resolve-local "Expands to sym if it names a local in the current environment or nil otherwise" [sym] (if (contains? &env sym) sym)) (defn stack-trace "Returns the current stack trace beginning at the caller's frame" [] (let [trace (.getStackTrace (Thread/currentThread))] (java.util.Arrays/copyOfRange trace 2 (alength trace)))) (defn parse-throw+ "Returns a vector containing the message and cause that result from processing the arguments to throw+" [object cause & args] (let [[cause & args] (if (or (empty? args) (string? (first args))) (cons cause args) args) [fmt & args] (cond (next args) args (seq args) ["%s" (first args)] :else ["throw+: %s" (pr-str object)]) message (apply format fmt args)] [message cause])) (defn default-throw-hook "Default implementation of *throw-hook*" [context] (throw (get-throwable context))) (def ^{:dynamic true :doc "Hook to allow overriding the behavior of throw+. Must be bound to a function of one argument, a context map. Defaults to default-throw-hook."} *throw-hook* default-throw-hook) (defn throw-fn "Helper to throw a context based on arguments and &env from throw+" [object {cause :throwable} stack-trace & args] (let [[message cause] (apply parse-throw+ object cause args) context (make-context object message cause stack-trace)] (*throw-hook* context))) (defmacro rethrow "Within a try+ catch clause, throws the outermost wrapper of the caught object" [] `(throw (:throwable ~'&throw-context))) slingshot-0.12.2/src/slingshot/test.clj000066400000000000000000000040261246601103100200540ustar00rootroot00000000000000(ns slingshot.test (:require [clojure.test :refer :all] [slingshot.slingshot :refer [try+]])) (defmethod assert-expr 'thrown+? [msg form] ;; (is (thrown+? selector expr)) ;; Asserts that evaluating expr throws an object that matches ;; selector. Returns the thrown object. (let [selector (nth form 1) body (nthnext form 2)] `(try+ ~@body (do-report {:type :fail :message ~msg :expected '~form :actual "thrown+?: nothing was thrown"}) (catch ~selector e# (do-report {:type :pass :message ~msg :expected '~form :actual e#}) e#) (catch Object e# (do-report {:type :fail :message ~msg :expected '~form :actual (format "thrown+?: %s did not match %s" (pr-str e#) '~selector)}) e#)))) (defmethod assert-expr 'thrown+-with-msg? [msg form] ;; (is (thrown+-with-msg? s re expr)) ;; Asserts that evaluating expr throws an object that matches ;; selector. Also asserts that the associated message string matches ;; (with re-find) the regular expression re. Returns the thrown object. (let [selector (nth form 1) re (nth form 2) body (nthnext form 3)] `(try+ ~@body (do-report {:type :fail :message ~msg :expected '~form :actual "thrown+-with-msg?: nothing was thrown"}) (catch ~selector e# (if (re-find ~re (:message ~'&throw-context)) (do-report {:type :pass :message ~msg :expected '~form :actual e#}) (do-report {:type :fail :message ~msg :expected '~form :actual (format "thrown+-with-msg?: %s did not match %s" (pr-str (:message ~'&throw-context)) (pr-str '~re))})) e#) (catch Object e# (do-report {:type :fail :message ~msg :expected '~form :actual (format "thrown+-with-msg?: %s did not match %s" (pr-str e#) '~selector)}) e#)))) slingshot-0.12.2/test/000077500000000000000000000000001246601103100145575ustar00rootroot00000000000000slingshot-0.12.2/test/slingshot/000077500000000000000000000000001246601103100165715ustar00rootroot00000000000000slingshot-0.12.2/test/slingshot/slingshot_test.clj000066400000000000000000000420441246601103100223400ustar00rootroot00000000000000(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])))))) slingshot-0.12.2/test/slingshot/support_test.clj000066400000000000000000000101551246601103100220400ustar00rootroot00000000000000(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))))) slingshot-0.12.2/test/slingshot/test_test.clj000066400000000000000000000004441246601103100213030ustar00rootroot00000000000000(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"))))