pax_global_header00006660000000000000000000000064117664644050014527gustar00rootroot0000000000000052 comment=5fd2b1f330dc3bf9a4164f1f2b0de0b162f5ef2e slingshot-0.10.3/000077500000000000000000000000001176646440500136225ustar00rootroot00000000000000slingshot-0.10.3/.gitignore000066400000000000000000000000731176646440500156120ustar00rootroot00000000000000pom.xml *jar /lib/ /classes/ .lein-failures .lein-deps-sum slingshot-0.10.3/CHANGES000066400000000000000000000055331176646440500146230ustar00rootroot00000000000000* 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) slingshot-0.10.3/README.md000066400000000000000000000124051176646440500151030ustar00rootroot00000000000000slingshot ========= 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 new 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+`, 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: :object the caught object; :message the message, from the optional argument(s) to throw+; :cause the cause, captured by throw+, see below; :stack-trace the stack trace, captured by throw+; :environment a map from names to values for locals visible at the throw+ site. :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. The wrapper is available via the `:wrapper` key in `&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`). `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+. Usage ----- project.clj [slingshot "0.10.3"] tensor/parse.clj (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 (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 Stephen C. Gilardi, Kevin Downey, and Phil Hagelberg Distributed under the Eclipse Public License, the same as Clojure. slingshot-0.10.3/java/000077500000000000000000000000001176646440500145435ustar00rootroot00000000000000slingshot-0.10.3/java/src/000077500000000000000000000000001176646440500153325ustar00rootroot00000000000000slingshot-0.10.3/java/src/slingshot/000077500000000000000000000000001176646440500173445ustar00rootroot00000000000000slingshot-0.10.3/java/src/slingshot/ExceptionInfo.java000066400000000000000000000006211176646440500227600ustar00rootroot00000000000000package slingshot; import clojure.lang.IPersistentMap; // see namespace doc for slingshot.ex-info public class ExceptionInfo extends RuntimeException { final IPersistentMap data; public ExceptionInfo(String message, IPersistentMap data, Throwable cause) { super(message, cause); this.data = data; } public IPersistentMap getData () { return data; } } slingshot-0.10.3/project.clj000066400000000000000000000003221176646440500157570ustar00rootroot00000000000000(defproject slingshot "0.10.3" :description "Enhanced throw, try, leveraging Clojure's capabilities" :dependencies [[org.clojure/clojure "1.2.1"]] :java-source-path "java/src" :warn-on-reflection true) slingshot-0.10.3/src/000077500000000000000000000000001176646440500144115ustar00rootroot00000000000000slingshot-0.10.3/src/slingshot/000077500000000000000000000000001176646440500164235ustar00rootroot00000000000000slingshot-0.10.3/src/slingshot/ex_info.clj000066400000000000000000000017131176646440500205460ustar00rootroot00000000000000(ns slingshot.ex-info "provides implementations of ex-info and ex-data for slingshot to use with clojure versions earlier than 1.4.0 ex-info and ex-data are currently scheduled to be available in clojure.core starting with release 1.4.0. These implementations are based on that code (issue CLJ-733), using slingshot.ExceptionInfo in place of clojure.lang.ExceptionInfo. This allows slingshot to be compatible with previous versions of clojure while also fully supporting clojure.1.4.0 and whatever tools may be created based on clojure.lang.ExceptionInfo." (import slingshot.ExceptionInfo)) (defn ex-info "Create an instance of ExceptionInfo, a RuntimeException subclass that carries a map of additional data." [msg map cause] (ExceptionInfo. msg map cause)) (defn ex-data "Returns exception data (a map) if ex is an ExceptionInfo. Otherwise returns nil." [ex] (when (instance? ExceptionInfo ex) (.getData ^ExceptionInfo ex))) slingshot-0.10.3/src/slingshot/slingshot.clj000066400000000000000000000125421176646440500211330ustar00rootroot00000000000000(ns slingshot.slingshot (:require [slingshot.support :as s])) (defmacro try+ "Like the try special form, but with enhanced catch clauses: - catch non-Throwable objects thrown by throw+ 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; - in a catch clause, access the names and values of the locals visible at the throw site, including the name of the enclosing function and its arguments (unless shadowed by nested locals). 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 catch-clauses finally-clauses] (s/parse-try+ body)] `(try ~@expressions ~@(s/transform-catch catch-clauses `throw+) ~@finally-clauses))) (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, throw+ packages the object, message, cause, stack trace, and environment in a Throwable wrapper: - message: optional, specified either by a string or a format string and args for clojure.core/format: - % symbols (at any nesting depth) within args represent the thrown object - the default is: \"throw+: %s\" (pr-str %) - cause: for a throw+ call within a try+ catch clause, the cause is the outermost wrapper of the caught object being processed. In any other case, the cause is nil; - stack trace: the stack trace of the current thread at the time of the throw+ call, starting at the function that encloses it; - environment: a map from names to values for locals visible at the throw+ call site, including the enclosing function and its arguments (unless shadowed by nested locals). 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" ([object] `(throw+ ~object "throw+: %s" (pr-str ~'%))) ([object message] `(throw+ ~object "%s" ~message)) ([object fmt arg & args] `(let [environment# (s/environment) ~'% ~object message# (apply format (list ~fmt ~arg ~@args)) stack-trace# (s/stack-trace)] (s/throw-context ~'% message# stack-trace# environment#))) ([] `(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+, 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: :object the object; :message the message, see throw+; :cause the cause, see throw+; :stack-trace the stack trace, see throw+; :environment the environment, see throw+; :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+ 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+. See also get-throw-context" [t] (-> t get-throw-context :object)) slingshot-0.10.3/src/slingshot/support.clj000066400000000000000000000175611176646440500206430ustar00rootroot00000000000000(ns slingshot.support (:require [clojure.walk]) (:refer-clojure :exclude [ex-data ex-info])) (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)))) ;; ex-info support (def ex-info-ns (if (and (resolve 'clojure.core/ex-info) (resolve 'clojure.core/ex-data)) 'clojure.core (doto 'slingshot.ex-info require))) (def ex-info @(ns-resolve ex-info-ns 'ex-info)) (def ex-data @(ns-resolve ex-info-ns 'ex-data)) (def ex-class (ns-resolve ex-info-ns 'ExceptionInfo)) ;; context support (defn make-context "Makes a throw context from arguments. Captures the cause from the environment argument if present." ([^Throwable t] {:object t :message (.getMessage t) :cause (.getCause t) :stack-trace (.getStackTrace t)}) ([object message stack-trace environment] {:object object :message message :cause (:throwable (environment '&throw-context)) :stack-trace stack-trace :environment (dissoc environment '&throw-context)})) (defn wrap "Returns a context wrapper given a context" [context] (let [{:keys [message cause stack-trace]} context data (-> (dissoc context :message :cause :stack-trace) (vary-meta assoc ::wrapper? true)) ^Throwable wrapper (ex-info message data cause)] (doto wrapper (.setStackTrace stack-trace)))) (defn unwrap "If t is a context wrapper, returns the context with t assoc'd as the value for :wrapper, else returns nil" [^Throwable t] (when-let [data (ex-data t)] (when (::wrapper? (meta data)) (-> (assoc data :message (.getMessage t) :cause (.getCause t) :stack-trace (.getStackTrace t) :wrapper t) (vary-meta dissoc ::wrapper?))))) (defn unwrap-all "Searches Throwable t and its cause chain for a context wrapper. If one is found, returns the context with the wrapper assoc'd as the value for :wrapper, else returns nil." [^Throwable t] (or (unwrap t) (when-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, returns the 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 '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) [f & groups] (match-or-defer groups :finally-clause)] (if (and (nil? groups) (<= (count f) 1)) [e c f] (throw-arg "try+ form must match: %s" "(try+ expression* catch-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 transform-catch "Transforms a seq of catch clauses for try+ into a seq of 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] (letfn [(cond-test [selector] (letfn [(class-name [] (and (symbol? selector) (class? (resolve selector)) `(instance? ~selector ~'%))) (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 (class-name) (key-values) (selector-form) (predicate))))) (cond-expression [binding-form expressions] `(let [~binding-form (:object ~'&throw-context)] ~@expressions)) (transform [[_ selector binding-form & expressions]] [(cond-test selector) (cond-expression binding-form expressions)])] (list ;; the code below uses only one local name to minimize clutter ;; in the &env captured by throw+ forms within catch clauses ;; (see the special handling of &throw-context in make-context) `(catch Throwable ~'&throw-context (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))))))) ;; throw+ support (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)))) (defmacro environment "Expands to code that generates a map of locals: names to values" [] `(zipmap '~(keys &env) [~@(keys &env)])) (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-context "Throws a context. Allows overrides of *throw-hook* to intervene." [object message stack-trace environment] (*throw-hook* (make-context object message stack-trace environment))) (defmacro rethrow "Within a try+ catch clause, throws the outermost wrapper of the caught object" [] `(throw (:throwable ~'&throw-context))) slingshot-0.10.3/src/slingshot/test.clj000066400000000000000000000040011176646440500200670ustar00rootroot00000000000000(ns slingshot.test (:use [clojure.test] [slingshot.slingshot :only [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.10.3/test/000077500000000000000000000000001176646440500146015ustar00rootroot00000000000000slingshot-0.10.3/test/slingshot/000077500000000000000000000000001176646440500166135ustar00rootroot00000000000000slingshot-0.10.3/test/slingshot/test/000077500000000000000000000000001176646440500175725ustar00rootroot00000000000000slingshot-0.10.3/test/slingshot/test/slingshot.clj000066400000000000000000000247121176646440500223040ustar00rootroot00000000000000(ns slingshot.test.slingshot (:use [clojure.test] [slingshot.slingshot :only [try+ throw+ get-throw-context get-thrown-object]]) (: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??"))))) (defn test-func [x y] (try+ (mult-func x y) (catch x-failure {message :message} [message (select-keys (:environment &throw-context) '(a b x y))]))) (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 (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 (first 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-locals-and-destructuring (is (= 1155 (test-func 3 5))) (is (= ["x isn't 3... really??" {'x 4 'y 7 'a 7 'b 11}] (test-func 4 7)))) (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 :environment :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 :environment :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))))) slingshot-0.10.3/test/slingshot/test/support.clj000066400000000000000000000063271176646440500220100ustar00rootroot00000000000000(ns slingshot.test.support (:use [clojure.test] [slingshot.slingshot :only [throw+ try+]] [slingshot.support]) (:refer-clojure :exclude [ex-data ex-info]) (:import (java.util.concurrent ExecutionException))) (deftest test-parse-try+ (let [f parse-try+] (is (= [nil nil nil]) (f ())) (is (= ['(1) nil nil] (f '(1)))) (is (= [nil '((catch 1)) nil] (f '((catch 1))))) (is (= [nil nil '((finally 1))] (f '((finally 1))))) (is (= ['(1) '((catch 1)) nil] (f '(1 (catch 1))))) (is (= ['(1) nil '((finally 1))] (f '(1 (finally 1))))) (is (= ['(1) '((catch 1)) '((finally 1))] (f '(1 (catch 1) (finally 1))))) (is (= ['(1) '((catch 1) (catch 2)) '((finally 1))] (f '(1 (catch 1) (catch 2) (finally 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))))))) (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-wrap [] (let [tmessage "test-wrap-1" tobject 4 tcause (Exception.) tstack-trace (stack-trace) tdata {:object tobject :environment {'a 1 'b 2}} 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 :environment]))) (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 :environment :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.10.3/test/slingshot/test/test.clj000066400000000000000000000004201176646440500212370ustar00rootroot00000000000000(ns slingshot.test.test (:use [clojure.test] [slingshot.slingshot :only [throw+]]) (:require [slingshot.test])) (deftest test-slingshot-test-macros (is (thrown+? string? (throw+ "test"))) (is (thrown+-with-msg? string? #"th" (throw+ "test" "hi there"))))