# clojure-test-suite conformance: runs the external, cross-dialect
# clojure-test-suite (jank-lang fork) against Jolt and asserts the number of
# passing per-function test files stays at/above a baseline. The suite is a git
# submodule at vendor/clojure-test-suite (CI checks it out via submodules:
# recursive). The test SKIPS cleanly only if the submodule isn't initialized
# (run `git submodule update --init`).
#
# Each suite file is a `clojure.test` namespace (one per clojure.core/string
# function). A minimal clojure.test + portability shim (test/support/clojure_test.clj)
# lets Jolt load them; `when-var-exists` auto-skips fns Jolt doesn't implement.
#
# Files are run in a one-shot worker subprocess (test/integration/suite-worker.janet)
# under a wall-clock deadline. A few suite tests build infinite sequences that an
# uncompilable/eager path can't truncate and so HANG rather than fail; the
# deadline contains them — a timed-out file contributes nothing, no skip-list.

(def suite-dir "vendor/clojure-test-suite/test/clojure")

# Baseline: assertions Jolt currently passes across the suite. Raise as Jolt
# improves so a regression (previously-passing assertion breaking) is caught.
# Lowered 3915 -> 3913 when futures landed: `realized?`/realized_qmark.cljc has a
# `(when-var-exists future ...)` block that was skipped while `future` was
# unresolved. With futures implemented the block now runs, but it depends on JVM
# `Thread/sleep` (jolt has no JVM interop) and on `future-cancel` interrupting a
# running thread (Janet OS threads can't be interrupted), so `(deref (future
# (sleep 1)))` re-raises the unresolved-`Thread/sleep` error — a documented
# platform gap, not a regression in any previously-working behavior.
# Raised 3913 -> 3916 with the staged-bootstrap kernel tier (ns-restore-on-throw
# + faithful subvec coercion), then 3916 -> 3919 moving juxt/every-pred/some-fn to
# Clojure (the canonical defs are more correct than the prior Janet ones). Raised
# 3919 -> 3926 preserving nil map values (jolt-c7h): a nil value is a present key,
# which several suite tests assert. Runs read 3927 consistently, occasionally 3926
# when a timeout-prone test (of the 9 that can time out) doesn't finish; floor at
# the consistent-minus-one 3926.
# Raised 3971 -> 3981 with Option A full laziness (jolt-fng): transformers return
# lazy seqs, lazy interleave stops timing out, and the lazy-seq nil-element +
# non-seqable-input fixes (case/seq/reverse/empty? over nil-first lazy seqs;
# lazy-from throws on non-seqable like Clojure) recovered + extended the suite.
# clean files 45 -> 66 (Option A makes seq?/vector? results match Clojure across
# many cross-dialect files). Stable across runs.
# Raised 3981 -> 4004 migrating 7 lazy seq fns to the Clojure overlay (40-lazy
# tier): the canonical CLJ versions add coverage (e.g. distinct value-equality).
# Raised 4004 -> 4034 / clean 66 -> 67 porting partition-all + repeatedly to the
# overlay, which required fixing two leniencies (a char is not callable; take
# validates its count) — correct beyond those fns, so the suite rose broadly.
(def baseline-pass 4081)
# A file is "clean" when it ran with zero failures AND zero errors.
(def baseline-clean-files 72)
# Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so
# this normally only fires on genuinely-infinite-sequence hangs. It's an env var
# (JOLT_SUITE_TIMEOUT) so CI — whose runners are slower than a dev machine — can
# give slow-but-finite files generous headroom without timing them out (which
# would drop total-pass below the baseline and flake CI red). Default 6 locally.
(def per-file-timeout
  (let [e (os/getenv "JOLT_SUITE_TIMEOUT")]
    (or (and e (scan-number e)) 6)))

(defn- walk [dir acc]
  (each e (os/dir dir)
    (def p (string dir "/" e))
    (case ((os/stat p) :mode)
      :directory (walk p acc)
      :file (when (and (string/has-suffix? ".cljc" p)
                       (not (string/has-suffix? "portability.cljc" p)))
              (array/push acc p))))
  acc)

# Run one file in a worker subprocess; return its "pass fail error" stdout, or
# nil if it exceeded the deadline (hang) or crashed.
(defn- run-file [path]
  (def proc (os/spawn ["janet" "test/integration/suite-worker.janet" path] :p {:out :pipe}))
  (def out (proc :out))
  (var data nil)
  (def ok
    (try
      (ev/with-deadline per-file-timeout
        (set data (ev/read out 0x10000))   # workers print a single short line
        (os/proc-wait proc)
        true)
      ([err] false)))
  (when (not ok)
    (protect (os/proc-kill proc true))
    (protect (ev/with-deadline 2 (os/proc-wait proc))))
  (protect (:close out))
  (if (and ok data) (string data) nil))

(defn- parse-counts [s]
  # Find the "@@COUNTS p f e" sentinel line (a test body may have printed other
  # lines to stdout, e.g. with-out-str tests).
  (var result nil)
  (each line (string/split "\n" s)
    (when (string/has-prefix? "@@COUNTS " line)
      (let [parts (string/split " " (string/trim line))]
        (when (= 4 (length parts))
          (set result [(scan-number (parts 1)) (scan-number (parts 2)) (scan-number (parts 3))])))))
  result)

(if (not (os/stat suite-dir))
    (print "clojure-test-suite: vendor/clojure-test-suite not initialized — skipped (run: git submodule update --init)")
    (do
      (def progress? (os/getenv "SUITE_PROGRESS"))
      (def files (sort (walk suite-dir @[])))
      (var total-pass 0)
      (var total-fail 0)
      (var total-error 0)
      (var clean-files 0)
      (var ran-files 0)
      (var timeouts 0)
      (def worst @[])

      # Worker pool: each file is already its own subprocess (isolation + hang
      # containment), so concurrency only changes wall-clock. A token-channel
      # semaphore caps the live workers; os/spawn / ev/read / os/proc-wait are
      # event-loop aware so the fibers genuinely interleave. Totals are
      # order-independent. Default 4 keeps per-file wall-clock deadlines honest
      # on small CI runners; override with JOLT_SUITE_WORKERS.
      (def nworkers
        (min 8 (max 1 (or (scan-number (or (os/getenv "JOLT_SUITE_WORKERS") ""))
                          (os/cpu-count) 4))))
      (def sem (ev/chan nworkers))
      (def done (ev/chan (length files)))
      (each path files
        (ev/spawn
          (ev/give sem :tok)                 # acquire (blocks when pool is full)
          (def out (run-file path))
          (ev/take sem)                      # release
          (ev/give done [path out])))
      (for _ 0 (length files)
        (def [path out] (ev/take done))
        (def rel (string/slice path (+ 1 (length suite-dir))))
        (def counts (and out (parse-counts out)))
        (when progress?
          (eprintf "  %s%s" rel (cond (nil? out) " TIMEOUT" (nil? counts) " (no counts)" ""))
          (eflush))
        (cond
          (nil? out) (++ timeouts)
          (nil? counts) nil
          (let [[pn fn* en] counts]
            (++ ran-files)
            (+= total-pass pn)
            (+= total-fail fn*)
            (+= total-error en)
            (when (and (= 0 fn*) (= 0 en) (> pn 0)) (++ clean-files))
            (when (> (+ fn* en) 0) (array/push worst [(+ fn* en) rel pn fn* en])))))

      (def total (+ total-pass total-fail total-error))
      (printf "\nclojure-test-suite: %d files ran (%d timed out), %d assertions — %d pass / %d fail / %d error"
              ran-files timeouts total total-pass total-fail total-error)
      (printf "\n  clean files (0 fail/error, >0 pass): %d" clean-files)
      (sort-by (fn [x] (- (x 0))) worst)
      (when (> (length worst) 0)
        (print "  top files by fail+error:")
        (each w (slice worst 0 (min 15 (length worst)))
          (printf "    %-40s pass=%d fail=%d err=%d" (w 1) (w 2) (w 3) (w 4))))

      (assert (>= total-pass baseline-pass)
              (string/format "regression: total-pass %d < baseline %d" total-pass baseline-pass))
      (assert (>= clean-files baseline-clean-files)
              (string/format "regression: clean-files %d < baseline %d" clean-files baseline-clean-files))
      (printf "\nclojure-test-suite: OK (>= %d pass, >= %d clean files)\n" baseline-pass baseline-clean-files)))