luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

only 4 left

Browse source
This commit is contained in:
Michiel Borkent 2022-10-02 11:32:53 +02:00
parent 5b4acf917a
commit 74ada71536
1 changed files with 16 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
src/babashka/impl/clojure/spec/test/alpha.clj
View file

@ -125,14 +125,14 @@
(let [fn-spec (@#'s/maybe-spec fn-spec) (let [fn-spec (@#'s/maybe-spec fn-spec)
conform! (fn [v role spec data args] conform! (fn [v role spec data args]
(let [conformed (s/conform spec data)] (let [conformed (s/conform spec data)]
(if (= ::s/invalid conformed) (if (= :clojure.spec.alpha/invalid conformed)
(let [caller (->> (.getStackTrace (Thread/currentThread)) (let [caller (->> (.getStackTrace (Thread/currentThread))
stacktrace-relevant-to-instrument stacktrace-relevant-to-instrument
first) first)
ed (merge (assoc (s/explain-data* spec [] [] [] data) ed (merge (assoc (s/explain-data* spec [] [] [] data)
::s/fn (->sym v) :clojure.spec.alpha/fn (->sym v)
::s/args args :clojure.spec.alpha/args args
::s/failure :instrument) :clojure.spec.alpha/failure :instrument)
(when caller (when caller
{::caller (dissoc caller :class :method)}))] {::caller (dissoc caller :class :method)}))]
(throw (ex-info (throw (ex-info
@ -143,7 +143,8 @@
[& args] [& args]
(if @instrument-enabled-var (if @instrument-enabled-var
(sci/binding [instrument-enabled-var false] (sci/binding [instrument-enabled-var false]
(when (:args fn-spec) (conform! v :args (:args fn-spec) args args)) (when (:args fn-spec)
(conform! v :args (:args fn-spec) args args))
(sci/binding [instrument-enabled-var true] (sci/binding [instrument-enabled-var true]
(.applyTo ^clojure.lang.IFn f args))) (.applyTo ^clojure.lang.IFn f args)))
(.applyTo ^clojure.lang.IFn f args))))) (.applyTo ^clojure.lang.IFn f args)))))
@ -151,7 +152,7 @@
(defn- no-fspec (defn- no-fspec
[v spec] [v spec]
(ex-info (str "Fn at " v " is not spec'ed.") (ex-info (str "Fn at " v " is not spec'ed.")
{:var v :spec spec ::s/failure :no-fspec})) {:var v :spec spec :clojure.spec.alpha/failure :no-fspec}))
(defonce ^:private instrumented-vars (atom {})) (defonce ^:private instrumented-vars (atom {}))
@ -169,7 +170,6 @@
(defn- instrument-1 (defn- instrument-1
[s opts] [s opts]
;; TODO: sci resolve
(when-let [v (sci/resolve @ctx s)] (when-let [v (sci/resolve @ctx s)]
(when-not (-> v meta :macro) (when-not (-> v meta :macro)
(let [spec (s/get-spec v) (let [spec (s/get-spec v)
@ -191,7 +191,6 @@
(swap! instrumented-vars dissoc v) (swap! instrumented-vars dissoc v)
(let [current @v] (let [current @v]
(when (= wrapped current) (when (= wrapped current)
;; TODO: use sci-alter-var-root
(sci/alter-var-root v (constantly raw)) (sci/alter-var-root v (constantly raw))
(->sym v)))))) (->sym v))))))
@ -290,18 +289,18 @@ Returns a collection of syms naming the vars unstrumented."
(assoc (s/explain-data* spec [role] [] [] v) (assoc (s/explain-data* spec [role] [] [] v)
::args args ::args args
::val v ::val v
::s/failure :check-failed)))) :clojure.spec.alpha/failure :check-failed))))
(defn- check-call (defn- check-call
"Returns true if call passes specs, otherwise *returns* an exception "Returns true if call passes specs, otherwise *returns* an exception
with explain-data + ::s/failure." with explain-data + :clojure.spec.alpha/failure."
[f specs args] [f specs args]
(let [cargs (when (:args specs) (s/conform (:args specs) args))] (let [cargs (when (:args specs) (s/conform (:args specs) args))]
(if (= cargs ::s/invalid) (if (= cargs :clojure.spec.alpha/invalid)
(explain-check args (:args specs) args :args) (explain-check args (:args specs) args :args)
(let [ret (apply f args) (let [ret (apply f args)
cret (when (:ret specs) (s/conform (:ret specs) ret))] cret (when (:ret specs) (s/conform (:ret specs) ret))]
(if (= cret ::s/invalid) (if (= cret :clojure.spec.alpha/invalid)
(explain-check args (:ret specs) ret :ret) (explain-check args (:ret specs) ret :ret)
(if (and (:args specs) (:ret specs) (:fn specs)) (if (and (:args specs) (:ret specs) (:fn specs))
(if (s/valid? (:fn specs) {:args cargs :ret cret}) (if (s/valid? (:fn specs) {:args cargs :ret cret})
@ -338,7 +337,7 @@ with explain-data + ::s/failure."
(try (try
(cond (cond
(or (nil? f) (some-> v meta :macro)) (or (nil? f) (some-> v meta :macro))
{:failure (ex-info "No fn to spec" {::s/failure :no-fn}) {:failure (ex-info "No fn to spec" {:clojure.spec.alpha/failure :no-fn})
:sym s :spec spec} :sym s :spec spec}
(:args specd) (:args specd)
@ -346,7 +345,7 @@ with explain-data + ::s/failure."
(make-check-result s spec tcret)) (make-check-result s spec tcret))
:default :default
{:failure (ex-info "No :args spec" {::s/failure :no-args-spec}) {:failure (ex-info "No :args spec" {:clojure.spec.alpha/failure :no-args-spec})
:sym s :spec spec}) :sym s :spec spec})
(finally (finally
(when re-inst? (instrument s)))))) (when re-inst? (instrument s))))))
@ -404,7 +403,7 @@ keys
::stc/ret optional value returned by test.check/quick-check ::stc/ret optional value returned by test.check/quick-check
The value for :failure can be any exception. Exceptions thrown by The value for :failure can be any exception. Exceptions thrown by
spec itself will have an ::s/failure value in ex-data: spec itself will have an :clojure.spec.alpha/failure value in ex-data:
:check-failed at least one checked return did not conform :check-failed at least one checked return did not conform
:no-args-spec no :args spec provided :no-args-spec no :args spec provided
@ -425,7 +424,7 @@ spec itself will have an ::s/failure value in ex-data:
(defn- failure-type (defn- failure-type
[x] [x]
(::s/failure (ex-data x))) (:clojure.spec.alpha/failure (ex-data x)))
(defn- unwrap-failure (defn- unwrap-failure
[x] [x]
@ -435,7 +434,7 @@ spec itself will have an ::s/failure value in ex-data:
(defn- result-type (defn- result-type
"Returns the type of the check result. This can be any of the "Returns the type of the check result. This can be any of the
::s/failure keywords documented in 'check', or: :clojure.spec.alpha/failure keywords documented in 'check', or:
:check-passed all checked fn returns conformed :check-passed all checked fn returns conformed
:check-threw checked fn threw an exception" :check-threw checked fn threw an exception"