This commit is contained in:
Michiel Borkent 2022-09-30 13:16:39 +02:00
parent 988a21b73b
commit 847c802cad
3 changed files with 135 additions and 125 deletions

View file

@ -2,11 +2,10 @@
{:no-doc true} {:no-doc true}
(:require [babashka.impl.clojure.spec.alpha :as s :refer [sns]] (:require [babashka.impl.clojure.spec.alpha :as s :refer [sns]]
[babashka.impl.clojure.spec.gen.alpha :as gen] [babashka.impl.clojure.spec.gen.alpha :as gen]
[babashka.impl.clojure.spec.test.alpha :as test] [babashka.impl.clojure.spec.test.alpha :as test :refer [tns]]
[clojure.core :as c] [clojure.core :as c]
[sci.core :as sci :refer [copy-var]])) [sci.core :as sci :refer [copy-var]]))
(def tns (sci/create-ns 'clojure.spec.test.alpha nil))
(def gns (sci/create-ns 'clojure.spec.gen.alpha nil)) (def gns (sci/create-ns 'clojure.spec.gen.alpha nil))
(defn- ns-qualify (defn- ns-qualify
@ -92,13 +91,20 @@
'assert* (copy-var s/assert* sns) 'assert* (copy-var s/assert* sns)
'explain-printer (copy-var s/explain-printer sns) 'explain-printer (copy-var s/explain-printer sns)
;; PRIVATE, but exposed for expound ;; PRIVATE, but exposed for expound
'maybe-spec (copy-var s/maybe-spec sns)}) 'maybe-spec (copy-var s/maybe-spec sns)
'spec-name (copy-var s/spec-name sns)
'explain-data* (copy-var s/explain-data* sns)
'->sym (copy-var s/->sym sns)
'explain-str (copy-var s/explain-str sns)})
#_:clj-kondo/ignore #_:clj-kondo/ignore
(def test-namespace (def test-namespace
{'instrument (copy-var test/instrument tns) {'instrument (copy-var test/instrument tns)
'unstrument (copy-var test/unstrument tns) 'unstrument (copy-var test/unstrument tns)
'with-instrument-disabled (copy-var test/with-instrument-disabled tns)}) '*instrument-enabled* test/instrument-enabled-var
'with-instrument-disabled (copy-var test/with-instrument-disabled tns)
'stacktrace-relevant-to-instrument (copy-var test/stacktrace-relevant-to-instrument tns)
'spec-checking-fn (copy-var test/spec-checking-fn tns)})
#_:clj-kondo/ignore #_:clj-kondo/ignore
(def gen-namespace (def gen-namespace

View file

@ -95,7 +95,7 @@
(instance? clojure.lang.IObj spec) (instance? clojure.lang.IObj spec)
(with-meta spec (assoc (meta spec) :clojure.spec.alpha/name name)))) (with-meta spec (assoc (meta spec) :clojure.spec.alpha/name name))))
(defn- spec-name [spec] (defn spec-name [spec]
(cond (cond
(ident? spec) spec (ident? spec) spec
@ -234,6 +234,7 @@
(defn explain-printer (defn explain-printer
"Default printer for explain-data. nil indicates a successful validation." "Default printer for explain-data. nil indicates a successful validation."
[ed] [ed]
(binding [*out* sci/out]
(if ed (if ed
(let [problems (->> (:clojure.spec.alpha/problems ed) (let [problems (->> (:clojure.spec.alpha/problems ed)
(sort-by #(- (count (:in %)))) (sort-by #(- (count (:in %))))
@ -254,7 +255,7 @@
(print "\n\t" (pr-str k) " ") (print "\n\t" (pr-str k) " ")
(pr v))) (pr v)))
(newline))) (newline)))
(println "Success!"))) (println "Success!"))))
(def sns (sci/create-ns 'clojure.spec.alpha nil)) (def sns (sci/create-ns 'clojure.spec.alpha nil))
@ -274,7 +275,7 @@
(defn explain-str (defn explain-str
"Given a spec and a value that fails to conform, returns an explanation as a string." "Given a spec and a value that fails to conform, returns an explanation as a string."
[spec x] [spec x]
(with-out-str (explain spec x))) (sci/with-out-str (explain spec x)))
(declare valid?) (declare valid?)
@ -304,7 +305,7 @@
([spec] (gen spec nil)) ([spec] (gen spec nil))
([spec overrides] (gensub spec overrides [] {:clojure.spec.alpha/recursion-limit *recursion-limit*} spec))) ([spec overrides] (gensub spec overrides [] {:clojure.spec.alpha/recursion-limit *recursion-limit*} spec)))
(defn- ->sym (defn ->sym
"Returns a symbol from a symbol or var" "Returns a symbol from a symbol or var"
[x] [x]
(if (var? x) (if (var? x)

View file

@ -12,7 +12,8 @@
[babashka.impl.clojure.spec.alpha :as s] [babashka.impl.clojure.spec.alpha :as s]
[babashka.impl.clojure.spec.gen.alpha :as gen] [babashka.impl.clojure.spec.gen.alpha :as gen]
[babashka.impl.pprint :as pp] [babashka.impl.pprint :as pp]
[clojure.string :as str])) [clojure.string :as str]
[sci.core :as sci]))
(in-ns 'clojure.spec.test.check) (in-ns 'clojure.spec.test.check)
(in-ns 'babashka.impl.clojure.spec.test.alpha) (in-ns 'babashka.impl.clojure.spec.test.alpha)
@ -56,7 +57,11 @@ returns the set of all symbols naming vars in those nses."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private ^:dynamic *instrument-enabled* (def tns (sci/create-ns 'clojure.spec.test.alpha))
(def instrument-enabled-var (sci/new-dynamic-var '*instrument-enabled* true {:ns tns} ))
#_(def ^:private ^:dynamic *instrument-enabled*
"if false, instrumented fns call straight through" "if false, instrumented fns call straight through"
true) true)
@ -68,7 +73,7 @@ returns the set of all symbols naming vars in those nses."
(defmacro with-instrument-disabled (defmacro with-instrument-disabled
"Disables instrument's checking of calls, within a scope." "Disables instrument's checking of calls, within a scope."
[& body] [& body]
`(binding [*instrument-enabled* nil] `(binding [clojure.spec.test.alpha/*instrument-enabled* nil]
~@body)) ~@body))
(defn- interpret-stack-trace-element (defn- interpret-stack-trace-element
@ -100,7 +105,7 @@ For non-Clojure fns, :scope and :local-fn will be absent."
(when local (when local
{:local-fn (symbol (degensym local))})))) {:local-fn (symbol (degensym local))}))))
(defn- stacktrace-relevant-to-instrument (defn stacktrace-relevant-to-instrument
"Takes a coll of stack trace elements (as returned by "Takes a coll of stack trace elements (as returned by
StackTraceElement->vec) and returns a coll of maps as per StackTraceElement->vec) and returns a coll of maps as per
interpret-stack-trace-element that are relevant to a interpret-stack-trace-element that are relevant to a
@ -114,7 +119,7 @@ failure in instrument."
(drop-while plumbing?)) (drop-while plumbing?))
elems))) elems)))
(defn- spec-checking-fn (defn spec-checking-fn
[v f fn-spec] [v f fn-spec]
(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]
@ -135,10 +140,10 @@ failure in instrument."
conformed)))] conformed)))]
(fn (fn
[& args] [& args]
(if *instrument-enabled* (if @instrument-enabled-var
(with-instrument-disabled (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))
(binding [*instrument-enabled* 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)))))
@ -467,5 +472,3 @@ key with a count for each different :type of result."
(update (result-type result) (fnil inc 0)))) (update (result-type result) (fnil inc 0))))
{:total 0} {:total 0}
check-results))) check-results)))