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.alpha :as s :refer [sns]]
    [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]
    [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"}
-        clj-commons/clj-yaml {:mvn/version "0.7.109"}
+        org.clojure/data.xml {:mvn/version "0.2.0-alpha8"}
+        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
+     [babashka.impl.common :refer [ctx]]
+     [clojure.test.check]
      [clojure.test.check.generators]
-              [clojure.test.check.properties]))
+     [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)
@@ -56,7 +58,11 @@ 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))
+
+(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)
 
@@ -68,7 +74,7 @@ returns the set of all symbols naming vars in those nses."
 (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
@@ -100,7 +106,7 @@ 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
   interpret-stack-trace-element that are relevant to a
@@ -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)
-                                         ::s/args args
-                                         ::s/failure :instrument)
+                                              :clojure.spec.alpha/fn (->sym v)
+                                              :clojure.spec.alpha/args args
+                                              :clojure.spec.alpha/failure :instrument)
                                        (when caller
                                          {::caller (dissoc caller :class :method)}))]
                          (throw (ex-info
@@ -135,17 +141,21 @@ failure in instrument."
                        conformed)))]
     (fn
       [& args]
-     (if *instrument-enabled*
-       (with-instrument-disabled
-         (when (:args fn-spec) (conform! v :args (:args fn-spec) args args))
-         (binding [*instrument-enabled* true]
+      (if @instrument-enabled-var
+        (sci/binding [instrument-enabled-var false]
+          (when (:args fn-spec)
+            (conform! v :args (:args fn-spec) args args))
+          (sci/binding [instrument-enabled-var true]
             (.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 nil #_(resolve s)]
+  (when-let [v (sci/resolve @ctx s)]
     (when-not (-> v meta :macro)
       (let [spec (s/get-spec v)
             {:keys [raw wrapped]} (get @instrumented-vars v)
@@ -173,21 +182,19 @@ 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)]
-        ;; TODO: use sci alter-var-root
-        (alter-var-root v (constantly checked))
+            checked (@spec-checking-fn-var v ofn ospec)]
+        (sci/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
-          (alter-var-root v (constantly raw))
+          (sci/alter-var-root v (constantly raw))
           (->sym v))))))
 
 #_(defn- opt-syms
@@ -285,18 +292,18 @@ Returns a collection of syms naming the vars unstrumented."
      (assoc (s/explain-data* spec [role] [] [] v)
             ::args args
             ::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})
@@ -333,7 +340,7 @@ with explain-data + ::s/failure."
     (try
       (cond
         (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}
 
         (:args specd)
@@ -341,7 +348,7 @@ with explain-data + ::s/failure."
           (make-check-result s spec tcret))
 
         :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})
       (finally
         (when re-inst? (instrument s))))))
@@ -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
@@ -420,7 +427,7 @@ spec itself will have an ::s/failure value in ex-data:
 
 (defn- failure-type
   [x]
-  (::s/failure (ex-data x)))
+  (:clojure.spec.alpha/failure (ex-data x)))
 
 (defn- unwrap-failure
   [x]
@@ -430,7 +437,7 @@ 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"
@@ -467,5 +474,3 @@ key with a count for each different :type of result."
           (update (result-type result) (fnil inc 0))))
     {:total 0}
     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
@@ -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.classpath :as cp :refer [add-classpath]]
    [babashka.core :refer [windows?]]
    [babashka.fs :as fs]
    [clojure.edn :as edn]
    [clojure.java.io :as io]
-            [clojure.test :as t :refer [*report-counters*]]
-            [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)
-            ;; 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)]
+      (let [namespaces namespaces]
         (doseq [n namespaces]
+          (let [orchestra? (str/starts-with? (str n) "orchestra")]
+            (if orchestra?
+              nil ;; (alter-var-root #'st/spec-checking-fn (constantly ot/spec-checking-fn))
+              (alter-var-root #'st/spec-checking-fn (constantly orig-spec-checking-fn)))
+            (when-not orchestra?
               (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))))))))))
+                                (merge-with + status (dissoc m :type))))))))))))
 
 ;; Standard test-runner for libtests
 (let [lib-tests (edn/read-string (slurp (io/resource "bb-tested-libs.edn")))