wip

deps.edn

@@ -63,7 +63,7 @@
            :lib-tests
            {:extra-paths ["process/src" "process/test" "test-resources/lib_tests"]
             :extra-deps {org.clj-commons/clj-http-lite {:mvn/version "0.4.392"}
-                         org.babashka/spec.alpha {:git/url "https://github.com/babashka/spec.alpha"
+                         #_#_org.babashka/spec.alpha {:git/url "https://github.com/babashka/spec.alpha"
                                                   :sha "0dec1f88cbde74a0470b454396f09a03adb4ae39"}
                          lambdaisland/regal {:mvn/version "0.0.143"}
                          cprop/cprop {:mvn/version "0.1.16"}
@@ -104,7 +104,7 @@
                          org.clojure/core.specs.alpha {:mvn/version "0.2.62"}
                          reifyhealth/specmonstah {:git/url "https://github.com/reifyhealth/specmonstah", :sha "a2b357009a3aa99a0c2d2361f3bbcd0b0e36505e"}
                          exoscale/coax {:mvn/version "1.0.0-alpha14"}
-                         orchestra/orchestra {:mvn/version "2021.01.01-1"}
+                         orchestra/orchestra {:local/root "/tmp/orchestra"} #_{:mvn/version "2021.01.01-1"}
                          expound/expound {:mvn/version "0.8.10"}
                          integrant/integrant {:mvn/version "0.8.0"}
                          com.stuartsierra/dependency {:mvn/version "1.0.0"}

feature-spec-alpha/babashka/impl/spec.clj

@@ -1,13 +1,12 @@
 (ns babashka.impl.spec
   {:no-doc true}
-  (:require [babashka.impl.clojure.spec.alpha :as s]
+  (:require
-            [babashka.impl.clojure.spec.gen.alpha :as gen]
+   [babashka.impl.clojure.spec.alpha :as s :refer [sns]]
-            [babashka.impl.clojure.spec.test.alpha :as test]
+   [babashka.impl.clojure.spec.gen.alpha :as gen]
-            [clojure.core :as c]
+   [babashka.impl.clojure.spec.test.alpha :as test :refer [tns]]
-            [sci.core :as sci :refer [copy-var]]))
+   [clojure.core :as c]
+   [sci.core :as sci :refer [copy-var]]))
 
-(def sns (sci/create-ns 'clojure.spec.alpha nil))
-(def tns (sci/create-ns 'clojure.spec.test.alpha nil))
 (def gns (sci/create-ns 'clojure.spec.gen.alpha nil))
 
 (defn- ns-qualify
@@ -25,33 +24,100 @@
   the registry for k."
   [_ _ k spec-form]
   (let [k (if (symbol? k) (ns-qualify k) k)]
-    `(clojure.spec.alpha/def-impl '~k '~(s/res spec-form) ~spec-form)))
+    `(clojure.spec.alpha/def-impl '~k '~(#'s/res spec-form) ~spec-form)))
 
-;; TODO: fix error in clj-kondo: def is a special form which should always be resolved as the special form
-#_:clj-kondo/ignore
 (def spec-namespace
   {'def (sci/copy-var s/def sns)
    'def-impl (copy-var s/def-impl sns)
    'valid? (copy-var s/valid? sns)
    'gen (copy-var s/gen sns)
+   '* (copy-var s/* sns)
+   'rep-impl (copy-var s/rep-impl sns)
+   '+ (copy-var s/+ sns)
+   'rep+impl (copy-var s/rep+impl sns)
+   '? (copy-var s/? sns)
+   'maybe-impl (copy-var s/maybe-impl sns)
+   '& (copy-var s/& sns)
+   'amp-impl (copy-var s/amp-impl sns)
+   'and (copy-var s/and sns)
+   'and-spec-impl (copy-var s/and-spec-impl sns)
+   'or (copy-var s/or sns)
+   'or-spec-impl (copy-var s/or-spec-impl sns)
    'cat (copy-var s/cat sns)
    'cat-impl (copy-var s/cat-impl sns)
+   'alt (copy-var s/alt sns)
+   'alt-impl (copy-var s/alt-impl sns)
    'fdef (copy-var s/fdef sns)
    'fspec (copy-var s/fspec sns)
    'fspec-impl (copy-var s/fspec-impl sns)
-   ;; 372
+   'every (copy-var s/every sns)
+   'every-impl (copy-var s/every-impl sns)
+   'every-kv (copy-var s/every-kv sns)
+   'keys (copy-var s/keys sns)
+   'map-spec-impl (copy-var s/map-spec-impl sns)
+   'map-of (copy-var s/map-of sns)
    'spec (copy-var s/spec sns)
    'spec-impl (copy-var s/spec-impl sns)
-   #_#_'explain-data (copy-var s/explain-data sns)})
+   'tuple (copy-var s/tuple sns)
+   'tuple-impl (copy-var s/tuple-impl sns)
+   'coll-of (copy-var s/coll-of sns)
+   'conformer (copy-var s/conformer sns)
+   'int-in (copy-var s/int-in sns)
+   'int-in-range? (copy-var s/int-in-range? sns)
+   'double-in (copy-var s/double-in sns)
+   'inst-in (copy-var s/inst-in sns)
+   'inst-in-range? (copy-var s/inst-in-range? sns)
+   'conform (copy-var s/conform sns)
+   'explain-data (copy-var s/explain-data sns)
+   'describe (copy-var s/describe sns)
+   'form (copy-var s/form sns)
+   'unform (copy-var s/unform sns)
+   'nilable (copy-var s/nilable sns)
+   'nilable-impl (copy-var s/nilable-impl sns)
+   'nonconforming (copy-var s/nonconforming sns)
+   'get-spec (copy-var s/get-spec sns)
+   'exercise (copy-var s/exercise sns)
+   'merge (copy-var s/merge sns)
+   'merge-spec-impl (copy-var s/merge-spec-impl sns)
+   'keys* (copy-var s/keys* sns)
+   'with-gen (copy-var s/with-gen sns)
+   'check-asserts (copy-var s/check-asserts sns)
+   '*explain-out* s/explain-out-var
+   'multi-spec (copy-var s/multi-spec sns)
+   'multi-spec-impl (copy-var s/multi-spec-impl sns)
+   'spec? (copy-var s/spec? sns)
+   'assert (copy-var s/assert sns)
+   'assert* (copy-var s/assert* sns)
+   'explain-printer (copy-var s/explain-printer sns)
+   ;; PRIVATE, but exposed for expound
+   '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)
+   'registry (copy-var s/registry sns)
+   'explain-out (copy-var s/explain-out sns)})
 
 #_:clj-kondo/ignore
 (def test-namespace
   {'instrument (copy-var test/instrument tns)
-   'unstrument (copy-var test/unstrument tns)})
+   'unstrument (copy-var test/unstrument 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 test/spec-checking-fn-var})
+
+#_(let [syms '[uuid gen-for-pred lazy-prim set one-of any-printable vector-distinct boolean string-alphanumeric map delay simple-type char bind symbol-ns any shuffle lazy-prims cat double char-alpha int return gen-for-name symbol quick-check char-alphanumeric choose for-all* string-ascii frequency double* generate delay-impl lazy-combinators tuple string vector large-integer keyword-ns not-empty elements sample list large-integer* keyword hash-map ratio such-that fmap char-ascii simple-type-printable lazy-combinator bytes]]
+  #_:clj-kondo/ignore
+  (println
+   (zipmap (map #(list 'quote %) syms)
+           (map (fn [sym]
+                  (list 'copy-var (symbol "gen" (str sym)) 'gns))
+                syms))))
 
 #_:clj-kondo/ignore
 (def gen-namespace
-  {'generate (copy-var gen/generate gns)})
+  {(quote lazy-prim) (copy-var gen/lazy-prim gns), (quote char-alpha) (copy-var gen/char-alpha gns), (quote large-integer*) (copy-var gen/large-integer* gns), (quote bind) (copy-var gen/bind gns), (quote gen-for-pred) (copy-var gen/gen-for-pred gns), (quote lazy-combinator) (copy-var gen/lazy-combinator gns), (quote ratio) (copy-var gen/ratio gns), (quote keyword-ns) (copy-var gen/keyword-ns gns), (quote fmap) (copy-var gen/fmap gns), (quote char-alphanumeric) (copy-var gen/char-alphanumeric gns), (quote int) (copy-var gen/int gns), (quote such-that) (copy-var gen/such-that gns), (quote double*) (copy-var gen/double* gns), (quote quick-check) (copy-var gen/quick-check gns), (quote cat) (copy-var gen/cat gns), (quote one-of) (copy-var gen/one-of gns), (quote choose) (copy-var gen/choose gns), (quote uuid) (copy-var gen/uuid gns), (quote string-ascii) (copy-var gen/string-ascii gns), (quote string) (copy-var gen/string gns), (quote char) (copy-var gen/char gns), (quote tuple) (copy-var gen/tuple gns), (quote elements) (copy-var gen/elements gns), (quote simple-type) (copy-var gen/simple-type gns), (quote frequency) (copy-var gen/frequency gns), (quote symbol-ns) (copy-var gen/symbol-ns gns), (quote for-all*) (copy-var gen/for-all* gns), (quote simple-type-printable) (copy-var gen/simple-type-printable gns), (quote generate) (copy-var gen/generate gns), (quote boolean) (copy-var gen/boolean gns), (quote hash-map) (copy-var gen/hash-map gns), (quote gen-for-name) (copy-var gen/gen-for-name gns), (quote shuffle) (copy-var gen/shuffle gns), (quote delay-impl) (copy-var gen/delay-impl gns), (quote large-integer) (copy-var gen/large-integer gns), (quote map) (copy-var gen/map gns), (quote any) (copy-var gen/any gns), (quote vector) (copy-var gen/vector gns), (quote lazy-combinators) (copy-var gen/lazy-combinators gns), (quote return) (copy-var gen/return gns), (quote keyword) (copy-var gen/keyword gns), (quote list) (copy-var gen/list gns), (quote delay) (copy-var gen/delay gns), (quote vector-distinct) (copy-var gen/vector-distinct gns), (quote symbol) (copy-var gen/symbol gns), (quote lazy-prims) (copy-var gen/lazy-prims gns), (quote bytes) (copy-var gen/bytes gns), (quote double) (copy-var gen/double gns), (quote char-ascii) (copy-var gen/char-ascii gns), (quote string-alphanumeric) (copy-var gen/string-alphanumeric gns), (quote any-printable) (copy-var gen/any-printable gns), (quote not-empty) (copy-var gen/not-empty gns), (quote sample) (copy-var gen/sample gns), (quote set) (copy-var gen/set gns)})
 
 ;; def-impl
 ;; -> spec? ;; OK

resources/META-INF/babashka/deps.edn

@@ -30,8 +30,8 @@
         org.clojure/tools.cli {:mvn/version "1.0.206"},
         org.clojure/data.csv {:mvn/version "1.0.0"},
         cheshire/cheshire {:mvn/version "5.11.0"}
-        org.clojure/data.xml {:mvn/version "0.2.0-alpha6"}
+        org.clojure/data.xml {:mvn/version "0.2.0-alpha8"}
-        clj-commons/clj-yaml {:mvn/version "0.7.109"}
+        clj-commons/clj-yaml {:mvn/version "0.7.169"}
         com.cognitect/transit-clj {:mvn/version "1.0.329"}
         org.clojure/test.check {:mvn/version "1.1.1"}
         nrepl/bencode {:mvn/version "1.1.0"}
@@ -50,7 +50,7 @@
         org.clojure/data.priority-map {:mvn/version "1.1.0"}
         insn/insn {:mvn/version "0.5.2"}
         org.clojure/core.rrb-vector {:mvn/version "0.1.2"}
-        org.babashka/cli {:mvn/version "0.3.35"}}
+        org.babashka/cli {:mvn/version "0.4.37"}}
  :aliases {:babashka/dev
            {:main-opts ["-m" "babashka.main"]}
            :profile
@@ -63,7 +63,7 @@
            :lib-tests
            {:extra-paths ["process/src" "process/test" "test-resources/lib_tests"]
             :extra-deps {org.clj-commons/clj-http-lite {:mvn/version "0.4.392"}
-                         org.babashka/spec.alpha {:git/url "https://github.com/babashka/spec.alpha"
+                         #_#_org.babashka/spec.alpha {:git/url "https://github.com/babashka/spec.alpha"
                                                   :sha "0dec1f88cbde74a0470b454396f09a03adb4ae39"}
                          lambdaisland/regal {:mvn/version "0.0.143"}
                          cprop/cprop {:mvn/version "0.1.16"}
@@ -104,7 +104,7 @@
                          org.clojure/core.specs.alpha {:mvn/version "0.2.62"}
                          reifyhealth/specmonstah {:git/url "https://github.com/reifyhealth/specmonstah", :sha "a2b357009a3aa99a0c2d2361f3bbcd0b0e36505e"}
                          exoscale/coax {:mvn/version "1.0.0-alpha14"}
-                         orchestra/orchestra {:mvn/version "2021.01.01-1"}
+                         orchestra/orchestra {:local/root "/tmp/orchestra"} #_{:mvn/version "2021.01.01-1"}
                          expound/expound {:mvn/version "0.8.10"}
                          integrant/integrant {:mvn/version "0.8.0"}
                          com.stuartsierra/dependency {:mvn/version "1.0.0"}

script/uberjar

@@ -140,7 +140,7 @@ else
     BABASHKA_LEIN_PROFILES+=",-feature/test-check"
 fi
 
-if [ "$BABASHKA_FEATURE_SPEC_ALPHA" = "true" ]
+if [ "$BABASHKA_FEATURE_SPEC_ALPHA" != "false" ]
 then
     BABASHKA_LEIN_PROFILES+=",+feature/spec-alpha"
 else

script/uberjar.bat

@@ -106,7 +106,7 @@ set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/test-check
 set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/test-check
 )
 
-if "%BABASHKA_FEATURE_SPEC_ALPHA%"=="true" (
+if not "%BABASHKA_FEATURE_SPEC_ALPHA%"=="false" (
 set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/spec-alpha
 ) else (
 set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/spec-alpha

src/babashka/impl/classes.clj

@@ -111,7 +111,8 @@
     clojure.lang.RT
     {:methods [{:name "aget"}
                {:name "aset"}
-               {:name "aclone"}]}
+               {:name "aclone"}]
+     :fields [{:name "checkSpecAsserts"}]}
     clojure.lang.Compiler
     {:fields [{:name "specials"}
               {:name "CHAR_MAP"}]}

src/babashka/impl/clojure/spec/gen/alpha.clj

@@ -9,9 +9,12 @@
 (ns babashka.impl.clojure.spec.gen.alpha
     (:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector
                               char double int keyword symbol string uuid delay shuffle])
-    (:require [clojure.test.check]
+    (:require
-              [clojure.test.check.generators]
+     [babashka.impl.common :refer [ctx]]
-              [clojure.test.check.properties]))
+     [clojure.test.check]
+     [clojure.test.check.generators]
+     [clojure.test.check.properties]
+     [sci.core :as sci]))
 
 (alias 'c 'clojure.core)
 
@@ -20,12 +23,10 @@
   [& args]
   (apply @quick-check-ref args))
 
-(def ^:private for-all*-ref
-     (c/delay (clojure.test.check.properties/for-all*)))
 (defn for-all*
   "Dynamically loaded clojure.test.check.properties/for-all*."
   [& args]
-  (apply @for-all*-ref args))
+  (apply clojure.test.check.properties/for-all* args))
 
 (let [g? clojure.test.check.generators/generator?
       g clojure.test.check.generators/generate
@@ -52,7 +53,14 @@
   generator that delegates to that, but delays
   creation until used."
   [& body]
-  `(delay-impl (c/delay ~@body)))
+  `(clojure.spec.gen.alpha/delay-impl (c/delay ~@body)))
+
+(defmacro delay-internal
+  "given body that returns a generator, returns a
+  generator that delegates to that, but delays
+  creation until used."
+  [& body]
+  `(babashka.impl.clojure.spec.gen.alpha/delay-impl (c/delay ~@body)))
 
 (defmacro ^:skip-wiki lazy-combinator
   "Implementation macro, do not call directly."
@@ -65,6 +73,14 @@
          [& ~'args]
          (apply @g# ~'args)))))
 
+(defn gen-for-name
+  "Dynamically loads test.check generator named s."
+  [s]
+  (let [g (sci/eval-form @ctx s)]
+    (if (generator? g)
+      g
+      (throw (RuntimeException. (str "Var " s " is not a generator"))))))
+
 (defmacro ^:skip-wiki lazy-combinators
   "Implementation macro, do not call directly."
   [& syms]

src/babashka/impl/clojure/spec/test/alpha.clj

@@ -12,7 +12,9 @@
    [babashka.impl.clojure.spec.alpha :as s]
    [babashka.impl.clojure.spec.gen.alpha :as gen]
    [babashka.impl.pprint :as pp]
-   [clojure.string :as str]))
+   [babashka.impl.common :refer [ctx]]
+   [clojure.string :as str]
+   [sci.core :as sci]))
 
 (in-ns 'clojure.spec.test.check)
 (in-ns 'babashka.impl.clojure.spec.test.alpha)
@@ -27,13 +29,13 @@
   (@#'s/->sym x))
 
 #_(defn- ->var
-  [s-or-v]
+    [s-or-v]
-  (if (var? s-or-v)
+    (if (var? s-or-v)
-    s-or-v
+      s-or-v
-    (let [v (and (symbol? s-or-v) (resolve s-or-v))]
+      (let [v (and (symbol? s-or-v) (resolve s-or-v))]
-      (if (var? v)
+        (if (var? v)
-        v
+          v
-        (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var")))))))
+          (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var")))))))
 
 (defn- collectionize
   [x]
@@ -43,7 +45,7 @@
 
 (defn enumerate-namespace
   "Given a symbol naming an ns, or a collection of such symbols,
-returns the set of all symbols naming vars in those nses."
+  returns the set of all symbols naming vars in those nses."
   [ns-sym-or-syms]
   (into
    #{}
@@ -56,25 +58,29 @@ returns the set of all symbols naming vars in those nses."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private ^:dynamic *instrument-enabled*
+(def tns (sci/create-ns 'clojure.spec.test.alpha))
-  "if false, instrumented fns call straight through"
+
-  true)
+(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"
+    true)
 
 #_(defn- fn-spec?
-  "Fn-spec must include at least :args or :ret specs."
+    "Fn-spec must include at least :args or :ret specs."
-  [m]
+    [m]
-  (or (:args m) (:ret m)))
+    (or (:args m) (:ret m)))
 
 (defmacro with-instrument-disabled
   "Disables instrument's checking of calls, within a scope."
   [& body]
-  `(binding [*instrument-enabled* nil]
+  `(binding [clojure.spec.test.alpha/*instrument-enabled* nil]
      ~@body))
 
 (defn- interpret-stack-trace-element
   "Given the vector-of-syms form of a stacktrace element produced
-by e.g. Throwable->map, returns a map form that adds some keys
+  by e.g. Throwable->map, returns a map form that adds some keys
-guessing the original Clojure names. Returns a map with
+  guessing the original Clojure names. Returns a map with
 
   :class         class name symbol from stack trace
   :method        method symbol from stack trace
@@ -83,7 +89,7 @@ guessing the original Clojure names. Returns a map with
   :var-scope     optional Clojure var symbol scoping fn def
   :local-fn      optional local Clojure symbol scoping fn def
 
-For non-Clojure fns, :scope and :local-fn will be absent."
+  For non-Clojure fns, :scope and :local-fn will be absent."
   [[cls method file line]]
   (let [clojure? (contains? '#{invoke invokeStatic} method)
         demunge #(clojure.lang.Compiler/demunge %)
@@ -100,11 +106,11 @@ For non-Clojure fns, :scope and :local-fn will be absent."
            (when 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
-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
-failure in instrument."
+  failure in instrument."
   [elems]
   (let [plumbing? (fn [{:keys [var-scope]}]
                     (contains? '#{clojure.spec.test.alpha/spec-checking-fn} var-scope))]
@@ -114,19 +120,19 @@ failure in instrument."
                     (drop-while plumbing?))
               elems)))
 
-(defn- spec-checking-fn
+(defn spec-checking-fn* ;; renamed to we're forced to go through SCI var below
   [v f fn-spec]
   (let [fn-spec (@#'s/maybe-spec fn-spec)
         conform! (fn [v role spec data args]
                    (let [conformed (s/conform spec data)]
-                     (if (= ::s/invalid conformed)
+                     (if (= :clojure.spec.alpha/invalid conformed)
                        (let [caller (->> (.getStackTrace (Thread/currentThread))
                                          stacktrace-relevant-to-instrument
                                          first)
                              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
                                          {::caller (dissoc caller :class :method)}))]
                          (throw (ex-info
@@ -134,18 +140,22 @@ failure in instrument."
                                  ed)))
                        conformed)))]
     (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)
-         (binding [*instrument-enabled* true]
+            (conform! v :args (:args fn-spec) args args))
-           (.applyTo ^clojure.lang.IFn f args)))
+          (sci/binding [instrument-enabled-var true]
-       (.applyTo ^clojure.lang.IFn f args)))))
+            (.applyTo ^clojure.lang.IFn f args)))
+        (.applyTo ^clojure.lang.IFn f args)))))
+
+;; orchestra is going to override this
+(def spec-checking-fn-var (sci/new-var 'spec-checking-fn spec-checking-fn* {:ns tns}))
 
 (defn- no-fspec
   [v spec]
   (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 {}))
 
@@ -163,8 +173,7 @@ failure in instrument."
 
 (defn- instrument-1
   [s opts]
-  ;; TODO: sci resolve
+  (when-let [v (sci/resolve @ctx s)]
-  (when-let [v nil #_(resolve s)]
     (when-not (-> v meta :macro)
       (let [spec (s/get-spec v)
             {:keys [raw wrapped]} (get @instrumented-vars v)
@@ -173,27 +182,25 @@ failure in instrument."
             ospec (or (instrument-choose-spec spec s opts)
                       (throw (no-fspec v spec)))
             ofn (instrument-choose-fn to-wrap ospec s opts)
-            checked (spec-checking-fn v ofn ospec)]
+            checked (@spec-checking-fn-var v ofn ospec)]
-        ;; TODO: use sci alter-var-root
+        (sci/alter-var-root v (constantly checked))
-        (alter-var-root v (constantly checked))
         (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})
         (->sym v)))))
 
 (defn- unstrument-1
   [s]
-  (when-let [v nil #_(resolve s)]
+  (when-let [v (sci/resolve @ctx s)]
     (when-let [{:keys [raw wrapped]} (get @instrumented-vars v)]
       (swap! instrumented-vars dissoc v)
       (let [current @v]
         (when (= wrapped current)
-          ;; TODO: use sci-alter-var-root
+          (sci/alter-var-root v (constantly raw))
-          (alter-var-root v (constantly raw))
           (->sym v))))))
 
 #_(defn- opt-syms
-  "Returns set of symbols referenced by 'instrument' opts map"
+    "Returns set of symbols referenced by 'instrument' opts map"
-  [opts]
+    [opts]
-  (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))]))
+    (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))]))
 
 (defn- fn-spec-name?
   [s]
@@ -206,11 +213,11 @@ failure in instrument."
 that can be instrumented."
   ([] (instrumentable-syms nil))
   ([opts]
-     (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")
+   (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")
-     (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
+   (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
-                       (keys (:spec opts))
+                     (keys (:spec opts))
-                       (:stub opts)
+                     (:stub opts)
-                       (keys (:replace opts))])))
+                     (keys (:replace opts))])))
 
 (defn instrument
   "Instruments the vars named by sym-or-syms, a symbol or collection
@@ -252,14 +259,14 @@ Returns a collection of syms naming the vars instrumented."
   ([] (instrument (instrumentable-syms)))
   ([sym-or-syms] (instrument sym-or-syms nil))
   ([sym-or-syms opts]
-     (locking instrumented-vars
+   (locking instrumented-vars
-       (into
+     (into
-        []
+      []
-        (comp (filter (instrumentable-syms opts))
+      (comp (filter (instrumentable-syms opts))
-              (distinct)
+            (distinct)
-              (map #(instrument-1 % opts))
+            (map #(instrument-1 % opts))
-              (remove nil?))
+            (remove nil?))
-        (collectionize sym-or-syms)))))
+      (collectionize sym-or-syms)))))
 
 (defn unstrument
   "Undoes instrument on the vars named by sym-or-syms, specified
@@ -267,13 +274,13 @@ as in instrument. With no args, unstruments all instrumented vars.
 Returns a collection of syms naming the vars unstrumented."
   ([] (unstrument (map ->sym (keys @instrumented-vars))))
   ([sym-or-syms]
-     (locking instrumented-vars
+   (locking instrumented-vars
-       (into
+     (into
-        []
+      []
-        (comp (filter symbol?)
+      (comp (filter symbol?)
-              (map unstrument-1)
+            (map unstrument-1)
-              (remove nil?))
+            (remove nil?))
-        (collectionize sym-or-syms)))))
+      (collectionize sym-or-syms)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -283,20 +290,20 @@ Returns a collection of syms naming the vars unstrumented."
    "Specification-based check failed"
    (when-not (s/valid? spec v nil)
      (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
   "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]
   (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)
       (let [ret (apply f args)
             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)
           (if (and (:args specs) (:ret specs) (:fn specs))
             (if (s/valid? (:fn specs) {:args cargs :ret cret})
@@ -331,20 +338,20 @@ with explain-data + ::s/failure."
         f (or f (when v @v))
         specd (s/spec spec)]
     (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)
-      (let [tcret (quick-check f specd opts)]
+        (let [tcret (quick-check f specd opts)]
-        (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))))))
 
 (defn- sym->check-map
   [s]
@@ -363,17 +370,17 @@ with explain-data + ::s/failure."
 'check' for options and return."
   ([f spec] (check-fn f spec nil))
   ([f spec opts]
-     (validate-check-opts opts)
+   (validate-check-opts opts)
-     (check-1 {:f f :spec spec} opts)))
+   (check-1 {:f f :spec spec} opts)))
 
 (defn checkable-syms
   "Given an opts map as per check, returns the set of syms that
 can be checked."
   ([] (checkable-syms nil))
   ([opts]
-     (validate-check-opts opts)
+   (validate-check-opts opts)
-     (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
+   (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
-                       (keys (:spec opts))])))
+                     (keys (:spec opts))])))
 
 (defn check
   "Run generative tests for spec conformance on vars named by
@@ -399,7 +406,7 @@ keys
 ::stc/ret   optional value returned by test.check/quick-check
 
 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
 :no-args-spec   no :args spec provided
@@ -411,16 +418,16 @@ spec itself will have an ::s/failure value in ex-data:
   ([] (check (checkable-syms)))
   ([sym-or-syms] (check sym-or-syms nil))
   ([sym-or-syms opts]
-     (->> (collectionize sym-or-syms)
+   (->> (collectionize sym-or-syms)
-          (filter (checkable-syms opts))
+        (filter (checkable-syms opts))
-          (pmap
+        (pmap
-           #(check-1 (sym->check-map %) opts)))))
+         #(check-1 (sym->check-map %) opts)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting  ;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn- failure-type
   [x]
-  (::s/failure (ex-data x)))
+  (:clojure.spec.alpha/failure (ex-data x)))
 
 (defn- unwrap-failure
   [x]
@@ -430,16 +437,16 @@ spec itself will have an ::s/failure value in ex-data:
 
 (defn- result-type
   "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-threw    checked fn threw an exception"
   [ret]
   (let [failure (:failure ret)]
     (cond
-     (nil? failure) :check-passed
+      (nil? failure) :check-passed
-     (failure-type failure) (failure-type failure)
+      (failure-type failure) (failure-type failure)
-     :default :check-threw)))
+      :default :check-threw)))
 
 (defn abbrev-result
   "Given a check result, returns an abbreviated version
@@ -459,13 +466,11 @@ Returns a map with :total, the total number of results, plus a
 key with a count for each different :type of result."
   ([check-results] (summarize-results check-results abbrev-result))
   ([check-results summary-result]
-     (reduce
+   (reduce
-      (fn [summary result]
+    (fn [summary result]
-        (pp/pprint (summary-result result))
+      (pp/pprint (summary-result result))
-        (-> summary
+      (-> summary
-            (update :total inc)
+          (update :total inc)
-            (update (result-type result) (fnil inc 0))))
+          (update (result-type result) (fnil inc 0))))
-      {:total 0}
+    {:total 0}
-       check-results)))
+    check-results)))
-
-

src/babashka/impl/common.clj

@@ -1,6 +1,7 @@
-(ns babashka.impl.common)
+(ns babashka.impl.common
+  (:require [sci.core :as sci]))
 
 ;; placeholder for ctx
-(def ctx (volatile! nil))
+(def ctx (volatile! (sci/init {})))
 (def bb-edn (volatile! nil))
 (def debug (volatile! false))

src/babashka/impl/features.clj

@@ -17,7 +17,7 @@
 (def selmer?         (not= "false" (System/getenv "BABASHKA_FEATURE_SELMER")))
 (def logging?        (not= "false" (System/getenv "BABASHKA_FEATURE_LOGGING")))
 (def priority-map?   (not= "false" (System/getenv "BABASHKA_FEATURE_PRIORITY_MAP")))
-
+(def spec-alpha?     (not= "false" (System/getenv "BABASHKA_FEATURE_SPEC_ALPHA")))
 ;; excluded by default
 (def jdbc? (= "true" (System/getenv "BABASHKA_FEATURE_JDBC")))
 (def sqlite? (= "true" (System/getenv "BABASHKA_FEATURE_SQLITE")))
@@ -26,7 +26,6 @@
 (def hsqldb? (= "true" (System/getenv "BABASHKA_FEATURE_HSQLDB")))
 (def datascript? (= "true" (System/getenv "BABASHKA_FEATURE_DATASCRIPT")))
 (def lanterna? (= "true" (System/getenv "BABASHKA_FEATURE_LANTERNA")))
-(def spec-alpha? (= "true" (System/getenv "BABASHKA_FEATURE_SPEC_ALPHA")))
 (def rrb-vector? (= "true" (System/getenv "BABASHKA_FEATURE_RRB_VECTOR")))
 
 (when xml?

src/babashka/main.clj

@@ -61,7 +61,8 @@
    [sci.impl.namespaces :as sci-namespaces]
    [sci.impl.types :as sci-types]
    [sci.impl.unrestrict :refer [*unrestricted*]]
-   [sci.impl.vars :as vars])
+   [sci.impl.vars :as vars]
+   [clojure.stacktrace :as stacktrace])
   (:gen-class))
 
 (def windows?
@@ -853,7 +854,7 @@ Use bb run --help to show this help output.
                                    {})
                                res)))
                          (case namespace
-                           clojure.spec.alpha
+                           #_#_clojure.spec.alpha
                            (binding [*out* *err*]
                              (println "[babashka] WARNING: Use the babashka-compatible version of clojure.spec.alpha, available here: https://github.com/babashka/spec.alpha"))
                            clojure.core.specs.alpha
@@ -886,7 +887,7 @@ Use bb run --help to show this help output.
             _ (vreset! common/ctx sci-ctx)
             _ (when-let [pods (:pods @common/bb-edn)]
                 (when-let [pod-metadata (pods/load-pods-metadata
-                                          pods {:download-only (download-only?)})]
+                                         pods {:download-only (download-only?)})]
                   (vreset! pod-namespaces pod-metadata)))
             preloads (some-> (System/getenv "BABASHKA_PRELOADS") (str/trim))
             [expressions exit-code]
@@ -1127,4 +1128,31 @@ Use bb run --help to show this help output.
 
 ;;;; Scratch
 
+(defmacro in-native-image-or-aot
+  [& body]
+  `(when (or (System/getProperty "org.graalvm.nativeimage.kind")
+             (System/getProperty "com.oracle.graalvm.isaot"))
+     ~@body))
+
+(in-native-image-or-aot
+
+ #_(defn where-am-i [depth]
+   (let [ks [:fileName :lineNumber :className]]
+     (clojure.pprint/print-table
+      ks
+      (map (comp #(select-keys % ks) bean)
+           (take depth (.getStackTrace (Thread/currentThread)))))))
+
+ (alter-var-root #'require
+                 (fn [_old-req]
+                   (fn [& args]
+                     (prn :require-args args)
+                     (System/exit 1))))
+
+ (alter-var-root #'requiring-resolve
+                 (fn [_old-req]
+                   (fn [& args]
+                     (prn :requiring-resolve-args args)
+                     (System/exit 1)))))
+
 (comment)

test-resources/lib_tests/babashka/run_all_libtests.clj

@@ -1,13 +1,23 @@
 (ns babashka.run-all-libtests
-  (:require [babashka.classpath :as cp :refer [add-classpath]]
+  (:require
-            [babashka.core :refer [windows?]]
+   [babashka.classpath :as cp :refer [add-classpath]]
-            [babashka.fs :as fs]
+   [babashka.core :refer [windows?]]
-            [clojure.edn :as edn]
+   [babashka.fs :as fs]
-            [clojure.java.io :as io]
+   [clojure.edn :as edn]
-            [clojure.test :as t :refer [*report-counters*]]
+   [clojure.java.io :as io]
-            [clojure.string :as str]))
+   [clojure.spec.test.alpha :as st]
+   [clojure.string :as str]
+   [clojure.test :as t :refer [*report-counters*]]))
 
-(defmethod clojure.test/report :end-test-var [_m]
+#_(defmethod t/report :begin-test-var [m]
+    (println "Running" (subs (str (-> m :var str)) 2)))
+
+#_:clj-kondo/ignore
+(def orig-spec-checking-fn @#'clojure.spec.test.alpha/spec-checking-fn)
+
+(alter-var-root #'st/spec-checking-fn (constantly orig-spec-checking-fn))
+
+(defmethod t/report :end-test-var [_m]
   (when-let [rc *report-counters*]
     (let [{:keys [:fail :error]} @rc]
       (when (and (= "true" (System/getenv "BABASHKA_FAIL_FAST"))
@@ -35,17 +45,19 @@
 (defn test-namespaces [& namespaces]
   (let [namespaces (seq (filter test-namespace? namespaces))]
     (when (seq namespaces)
-      (let [no-orch-namespaces (remove #(str/starts-with? (str %) "orchestra") namespaces)
+      (let [namespaces namespaces]
-            ;; somehow orchestra screws up other tests, so we run that last
-            orch-namespaces (filter #(str/starts-with? (str %) "orchestra") namespaces)
-            namespaces (concat no-orch-namespaces orch-namespaces)]
         (doseq [n namespaces]
-          (require n)
+          (let [orchestra? (str/starts-with? (str n) "orchestra")]
-          (filter-vars! (find-ns n) #(-> % meta ((some-fn :skip-bb
+            (if orchestra?
-                                                          :test-check-slow)) not))
+              nil ;; (alter-var-root #'st/spec-checking-fn (constantly ot/spec-checking-fn))
-          (let [m (apply t/run-tests [n])]
+              (alter-var-root #'st/spec-checking-fn (constantly orig-spec-checking-fn)))
-            (swap! status (fn [status]
+            (when-not orchestra?
-                            (merge-with + status (dissoc m :type))))))))))
+              (require n)
+              (filter-vars! (find-ns n) #(-> % meta ((some-fn :skip-bb
+                                                              :test-check-slow)) not))
+              (let [m (apply t/run-tests [n])]
+                (swap! status (fn [status]
+                                (merge-with + status (dissoc m :type))))))))))))
 
 ;; Standard test-runner for libtests
 (let [lib-tests (edn/read-string (slurp (io/resource "bb-tested-libs.edn")))