root-cause (clj)

(deftest e-test
  (is-tc-e #(e) [-> Any]
           :requires [[clojure.stacktrace :refer [e]]]))

(deftest root-cause-test
  (is-tc-e #(root-cause (Exception. "a")) [-> Throwable]
           :requires [[clojure.stacktrace :refer [root-cause]]])
  (is-tc-err #(root-cause (Exception. "a")) [-> Exception]
             :requires [[clojure.stacktrace :refer [root-cause]]]))

(ns co.paralleluniverse.pulsar.async.exceptions-test
  "Verify that exceptions thrown on a thread pool managed by
  core.async will propagate out to the JVM's default uncaught
  exception handler."
  (:use midje.sweet)
  (:require
    [clojure.stacktrace :refer [root-cause]]
    [co.paralleluniverse.pulsar.core :as p]
    [co.paralleluniverse.pulsar.async :refer [chan go thread put! take! <!! >!!]])
  (:import (co.paralleluniverse.fibers Fiber)
           (co.paralleluniverse.strands Strand$UncaughtExceptionHandler)))

(fact "Exception in thread"
      (let [log (p/promise)]
        (with-default-uncaught-exception-handler-thread
          (p/sfn [_ throwable] (deliver log throwable))
          (p/sfn []
                 (let [ex (Exception. "This exception is expected")
                       ret (thread (throw ex))]
                   (<!! ret)
                   (fact (identical? ex (root-cause @log)) => true))))))

(fact "Exception in go"
      (let [log (p/promise)]
        (with-default-uncaught-exception-handler-fiber
          (p/sfn [_ throwable] (deliver log throwable))
          (p/sfn []
                 (let [ex (Exception. "This exception is expected")
                       ret (go (throw ex))]
                   (<!! ret)
                   (fact (root-cause @log) => ex))))))

(fact "Exception in put callback"
      (let [log (p/promise)]
        (with-default-uncaught-exception-handler-fiber
          (p/sfn [_ throwable] (deliver log throwable))
          (p/sfn []
                 (let [ex (Exception. "This exception is expected")
                       c (chan)]
                   (put! c :foo (fn [_] (throw ex)))
                   (<!! c)
                   (fact (root-cause @log) => ex))))))

(fact "Exception in take callback"
      (let [log (p/promise)]
        (with-default-uncaught-exception-handler-fiber
          (p/sfn [_ throwable] (deliver log throwable))
          (p/sfn []
                 (let [ex (Exception. "This exception is expected")
                       c (chan)]
                   (take! c (fn [_] (throw ex)))
                   (>!! c :foo)
                   (fact (root-cause @log) => ex))))))

(deftest e-test
  (is-tc-e #(e) [-> t/Any]
           :requires [[clojure.stacktrace :refer [e]]]))

(deftest root-cause-test
  (is-tc-e #(root-cause (Exception. "a")) [-> Throwable]
           :requires [[clojure.stacktrace :refer [root-cause]]])
  (is-tc-err #(root-cause (Exception. "a")) [-> Exception]
             :requires [[clojure.stacktrace :refer [root-cause]]]))

(ns spire.namespaces
  (:require [spire.ssh :as ssh]
            [spire.utils :as utils]
            [spire.context :as context]
            [spire.transport :as transport]
            [spire.state :as state]
            [spire.output.core]
            [spire.output.default]
            [spire.output.events]
            [spire.output.quiet]
            [spire.facts :as facts]
            [spire.selmer :as selmer]
            [spire.module.curl :as curl]
            [spire.module.line-in-file :as line-in-file]
            [spire.module.get-file :as get-file]
            [spire.module.download :as download]
            [spire.module.upload :as upload]
            [spire.module.user :as user]
            [spire.module.apt :as apt]
            [spire.module.aws :as aws]
            [spire.module.attrs :as attrs]
            [spire.module.apt-repo :as apt-repo]
            [spire.module.apt-key :as apt-key]
            [spire.module.pkg :as pkg]
            [spire.module.rm :as rm]
            [spire.module.group :as group]
            [spire.module.mkdir :as mkdir]
            [spire.module.shell :as shell]
            [spire.module.sysctl :as sysctl]
            [spire.module.service :as service]
            [spire.module.authorized-keys :as authorized-keys]
            [spire.module.stat :as stat]
            [spire.module.sudo :as sudo]
            [spire.local]
            [spire.remote]
            [spire.default]
            [clojure.tools.cli]
            [clojure.java.shell]
            [clojure.edn]
            [clojure.stacktrace :as stacktrace]
            [clojure.string]
            [clojure.set]
            [clojure.java.io]
            [clojure.data.json]
            [sci.core :as sci]
            [clj-http.lite.core]
            [clj-http.lite.client]
            [clj-http.lite.links]
            [clj-http.lite.util]
            [cheshire.core]
            [cheshire.custom]
            [cheshire.exact]
            [cheshire.experimental]
            [cheshire.factory]
            [cheshire.generate]
            [cheshire.generate-seq]
            [cheshire.parse]
            [fipp.edn]
            [edamame.core]
            [spire.sci :refer [make-sci-bindings
                               make-sci-bindings-clean
                               sci-bind-macro
                               clojure-repl]]
            [sci.impl.namespaces :refer [copy-var]]
            [sci.impl.vars :as vars]))

(def namespaces
  {
   'clojure.core {'slurp slurp
                  'spit spit
                  'future (with-meta @#'clojure.core/future {:sci/macro true})
                  'future-call clojure.core/future-call
                  '*in* (sci/new-dynamic-var '*in* *in*)
                  '*out* (sci/new-dynamic-var '*out* *out*)
                  '*err* (sci/new-dynamic-var '*err* *err*)
                  }
   'clojure.main {'repl-requires
                  '[[clojure.repl :refer [dir doc]]
                    [clojure.pprint :refer [pprint]]
                    [spire.default :refer [push-ssh! set-ssh!
                                           push-local! set-local!
                                           pop! empty!]]]}
   'clojure.pprint (make-sci-bindings fipp.edn)
   'clojure.repl clojure-repl
   'clojure.stacktrace {'root-cause stacktrace/root-cause
                        'print-trace-element (redirect-out-to-sci stacktrace/print-trace-element)
                        'print-throwable (redirect-out-to-sci stacktrace/print-throwable)
                        'print-stack-trace (redirect-out-to-sci stacktrace/print-stack-trace)
                        'print-cause-trace (redirect-out-to-sci stacktrace/print-cause-trace)}

(ns ketu.test.thrown-root-cause
  (:require [clojure.stacktrace]
            [clojure.test]))

(defmethod clojure.test/assert-expr 'thrown-root-cause-with-msg? [msg form]
  ;; Same as clojure.test/thrown-with-msg? but checks the root cause of the exception.
  (let [klass (nth form 1)
        re (nth form 2)
        body (nthnext form 3)]
    `(try ~@body
          (clojure.test/do-report {:type :fail, :message ~msg, :expected '~form, :actual nil})
          (catch Exception e#
            (let [^Throwable r# (clojure.stacktrace/root-cause e#)
                  m# (.getMessage r#)]
              (if (and (isa? (class r#) ~klass) (re-find ~re m#))
                (clojure.test/do-report {:type :pass, :message ~msg,
                                         :expected '~form, :actual e#})
                (clojure.test/do-report {:type :fail, :message ~msg,
                                         :expected '~form, :actual e#})))
            e#))))