e16085402b
Running clojure.tools.reader's own suite on jolt surfaced a batch of general gaps (all runtime, JVM-certified, no re-mint — reader.ss is loaded at runtime and jolt-core has no octal literals, so selfhost holds): Reader: - (load "rel") resolves a non-/ path against the current namespace's directory, like Clojure — (load "common_tests") from clojure.tools.reader-test loads clojure/tools/common_tests.clj. Was resolved against the roots directly. - Octal integer literals: 042 reads as 34, not decimal 42; octal string escapes (\377 is one char, not \0 + "00"). \oNNN char octal already worked. - (symbol nil name) now equals (symbol name) and the reader literal — a nil namespace is the #f no-ns sentinel, not jolt-nil (jolt= compares ns by equal?). clojure.test: - thrown-with-msg? honors the class hierarchy (instance?) before falling back to a simple-name match, so (thrown-with-msg? RuntimeException ...) matches an ExceptionInfo, like thrown? already did. Host interop (java layer): - java.util.regex: Pattern.matcher / Matcher.matches / .group / .groupCount / .find, and Pattern/compile. - clojure.lang: RT/map, PersistentList/create, PersistentHashSet/createWithCheck. - java.lang.Character: digit / isDigit / isWhitespace / valueOf. - java.util.LinkedList (Deque surface over the ArrayList backing); ArrayList / LinkedList are now seqable. - BigInteger 2-arg ctor (string, radix) + .negate / .bitLength / .signum / .abs; BigInt/fromBigInteger and Numbers/reduceBigInt (identity on jolt's exact ints). Suite: reader_test 22/30, reader-edn_test 13/16. The remaining failures are fundamental numeric-model differences (no BigDecimal type; BigInt and Long are one exact-integer type) or need JVM reflection (record/ctor tagged literals via getConstructors) — out of scope. make test green (+8 corpus rows, 0 new divergences), shakesmoke byte-identical.
191 lines
6.8 KiB
Clojure
191 lines
6.8 KiB
Clojure
; Jolt Standard Library: clojure.test
|
|
;
|
|
; A practical subset of clojure.test for running real test suites under Jolt:
|
|
; deftest / is / testing / are / use-fixtures / run-tests, with class-aware
|
|
; (thrown? Class body) and (thrown-with-msg? Class re body) inside `is`. Class
|
|
; matching is by simple-name (last dotted segment), since Jolt has no JVM class
|
|
; objects — Exception/Throwable match any thrown value.
|
|
;
|
|
; Also exposes the counter/registry API the internal clojure-test-suite harness
|
|
; uses (reset-report!, run-registered, n-pass/n-fail/n-error, failures), so this
|
|
; is a drop-in superset.
|
|
|
|
(ns clojure.test
|
|
(:require [clojure.string :as str]))
|
|
|
|
;; --- state -----------------------------------------------------------------
|
|
|
|
(def counters (atom {:test 0 :pass 0 :fail 0 :error 0 :fails []}))
|
|
(def jolt-report counters) ;; alias used by the suite harness
|
|
(def ctx-stack (atom []))
|
|
(def registry (atom [])) ;; [{:name sym :fn thunk}]
|
|
(def once-fixtures (atom []))
|
|
(def each-fixtures (atom []))
|
|
|
|
(defn reset-report! []
|
|
(reset! counters {:test 0 :pass 0 :fail 0 :error 0 :fails []})
|
|
(reset! ctx-stack [])
|
|
(reset! registry [])
|
|
(reset! once-fixtures [])
|
|
(reset! each-fixtures []))
|
|
|
|
(defn- ctx-str [] (str/join " " @ctx-stack))
|
|
|
|
(defn inc-pass! [] (swap! counters update :pass inc))
|
|
(defn fail! [form]
|
|
(let [line (str (ctx-str) (when (seq @ctx-stack) " ") "FAIL: " form)]
|
|
(swap! counters (fn [r] (-> r (update :fail inc) (update :fails conj line))))
|
|
(println line)))
|
|
(defn err! [form]
|
|
(let [line (str (ctx-str) (when (seq @ctx-stack) " ") "ERROR: " form)]
|
|
(swap! counters (fn [r] (-> r (update :error inc) (update :fails conj line))))
|
|
(println line)))
|
|
|
|
(defn n-pass [] (:pass @counters))
|
|
(defn n-fail [] (:fail @counters))
|
|
(defn n-error [] (:error @counters))
|
|
(defn failures [] (:fails @counters))
|
|
|
|
;; Message of a thrown value: ex-info's message, else a raw host condition's text
|
|
;; (ex-message is nil for those), else its printed form — so a crash is never
|
|
;; reported with a blank message.
|
|
(defn err-text [e]
|
|
(or (ex-message e)
|
|
(jolt.host/condition-message e)
|
|
(str e)))
|
|
|
|
;; clojure.test/report multimethod — present so suites that add reporting
|
|
;; methods (defmethod clojure.test/report :begin-test-var ...) load. The runner
|
|
;; below does its own console output and doesn't dispatch through it.
|
|
(defmulti report :type)
|
|
(defmethod report :default [_m] nil)
|
|
|
|
;; --- class matching for thrown? --------------------------------------------
|
|
|
|
(defn- last-seg [s]
|
|
(let [s (str s)
|
|
i (str/last-index-of s ".")]
|
|
(if i (subs s (inc i)) s)))
|
|
|
|
(defn class-match?
|
|
"True if thrown value `e` matches the wanted class simple-name `wanted`.
|
|
Exception/Throwable match anything."
|
|
[e wanted]
|
|
(let [w (last-seg wanted)]
|
|
(if (or (= w "Exception") (= w "Throwable"))
|
|
true
|
|
(let [c (class e)
|
|
cn (cond (nil? c) nil (string? c) c :else (.getName c))]
|
|
(and cn (= (last-seg cn) w))))))
|
|
|
|
;; --- assertion macros ------------------------------------------------------
|
|
|
|
(defn- thrown-form? [form sym]
|
|
(and (seq? form) (symbol? (first form)) (= sym (name (first form)))))
|
|
|
|
(defmacro is
|
|
([form] `(is ~form nil))
|
|
([form msg]
|
|
(cond
|
|
;; (is (thrown? Class body...))
|
|
(thrown-form? form "thrown?")
|
|
(let [klass-sym (second form)
|
|
klass (name klass-sym)
|
|
body (nthrest form 2)]
|
|
`(try
|
|
~@body
|
|
(clojure.test/fail! (str "expected " '~form " to throw" (when ~msg (str " — " ~msg))))
|
|
(catch Throwable e#
|
|
;; instance? honors the exception hierarchy (a literal class symbol), so
|
|
;; (thrown? IllegalArgumentException …) matches an ArityException subclass
|
|
;; like the JVM; class-match? is the simple-name fallback for a class jolt
|
|
;; models only by name.
|
|
(if (or (clojure.core/instance? ~klass-sym e#)
|
|
(clojure.test/class-match? e# ~klass))
|
|
(clojure.test/inc-pass!)
|
|
(clojure.test/fail! (str "expected throw of " ~klass " but got " (clojure.core/class e#)))))))
|
|
|
|
;; (is (thrown-with-msg? Class re body...))
|
|
(thrown-form? form "thrown-with-msg?")
|
|
(let [klass-sym (second form)
|
|
klass (name klass-sym)
|
|
re (nth form 2)
|
|
body (nthrest form 3)]
|
|
`(try
|
|
~@body
|
|
(clojure.test/fail! (str "expected " '~form " to throw"))
|
|
(catch Throwable e#
|
|
(let [m# (or (clojure.core/ex-message e#) (str e#))]
|
|
;; honor the class hierarchy (ExceptionInfo IS a RuntimeException),
|
|
;; then fall back to a simple-name match like thrown? does.
|
|
(if (and (or (clojure.core/instance? ~klass-sym e#)
|
|
(clojure.test/class-match? e# ~klass))
|
|
(re-find ~re m#))
|
|
(clojure.test/inc-pass!)
|
|
(clojure.test/fail! (str "expected throw of " ~klass " matching " ~re " but got " (clojure.core/class e#) ": " m#)))))))
|
|
|
|
:else
|
|
`(try
|
|
(if ~form
|
|
(clojure.test/inc-pass!)
|
|
(clojure.test/fail! (str (pr-str '~form) (when ~msg (str " — " ~msg)))))
|
|
(catch Throwable e#
|
|
(clojure.test/err! (str (pr-str '~form) " threw: " (clojure.test/err-text e#))))))))
|
|
|
|
(defmacro testing [s & body]
|
|
`(do
|
|
(swap! clojure.test/ctx-stack conj ~s)
|
|
(try
|
|
(do ~@body)
|
|
(finally (swap! clojure.test/ctx-stack pop)))))
|
|
|
|
(defmacro deftest [name & body]
|
|
`(do
|
|
(defn ~name [] ~@body)
|
|
(swap! clojure.test/registry conj {:name '~name :fn ~name})
|
|
(var ~name)))
|
|
|
|
(defmacro are [argv expr & data]
|
|
(let [n (count argv)
|
|
rows (partition n data)]
|
|
`(do ~@(map (fn [row]
|
|
`(let [~@(interleave argv row)]
|
|
(clojure.test/is ~expr)))
|
|
rows))))
|
|
|
|
;; --- fixtures + run --------------------------------------------------------
|
|
|
|
(defn use-fixtures [kind & fns]
|
|
(cond
|
|
(= kind :once) (reset! once-fixtures (vec fns))
|
|
(= kind :each) (reset! each-fixtures (vec fns))))
|
|
|
|
(defn- wrap-fixtures [fixtures body-fn]
|
|
(if (empty? fixtures)
|
|
(body-fn)
|
|
((first fixtures) (fn [] (wrap-fixtures (rest fixtures) body-fn)))))
|
|
|
|
(defn- run-one [t]
|
|
(swap! counters update :test inc)
|
|
(wrap-fixtures @each-fixtures
|
|
(fn []
|
|
(try
|
|
((:fn t))
|
|
(catch Throwable e
|
|
(err! (str (:name t) " crashed: " (err-text e))))))))
|
|
|
|
(defn run-registered []
|
|
(doseq [t @registry] (run-one t))
|
|
nil)
|
|
|
|
(defn run-tests [& _nses]
|
|
(wrap-fixtures @once-fixtures (fn [] (run-registered)))
|
|
(let [r @counters]
|
|
(println)
|
|
(println (str "Ran " (:test r) " tests. "
|
|
(:pass r) " assertions passed, "
|
|
(:fail r) " failures, " (:error r) " errors."))
|
|
r))
|
|
|
|
(defn run-test [& _] nil)
|
|
(defn test-var [& _] nil)
|