Pure-Chez test gates (no Janet)
Add a Janet-free gate so correctness can be judged with only Chez + Clojure: - host/chez/run-corpus.ss: corpus.edn vs JVM expecteds, lifting the per-case ns isolation from the old Janet driver; reads corpus.edn via the jolt reader. - host/chez/run-unit.ss + test/chez/unit.edn: the host-specific unit cases, evaluated in-process and compared to baked expecteds. - host/chez/selfcheck.sh: self-host fixpoint (bootstrap.ss rebuild == checked-in seed). - host/chez/smoke.sh: real bin/joltc CLI smoke. - host/chez/remint.sh: re-mint the seed to a byte-fixpoint after a source change. - Makefile: 'make test' runs the lot; 'make remint' rebuilds the seed. Numbers match the Janet gate: corpus 2679/2757 0 new div, unit 450/450, certify 0 new/0 stale. jolt-cf1q.6
This commit is contained in:
Yogthos
parent
9a273e71cd
commit
5c1fdfc336
7 changed files with 888 additions and 0 deletions
30
host/chez/remint.sh
Executable file
30
host/chez/remint.sh
Executable file
|
|
@ -0,0 +1,30 @@
|
|||
#!/bin/sh
|
||||
# Re-mint the checked-in Chez seed. Run after changing a seed source — the reader
|
||||
# (host/chez/reader.ss), the analyzer/IR/backend (jolt-core/jolt/*.clj), or the
|
||||
# clojure.core overlay (jolt-core/clojure/core/*.clj). Iterates bootstrap.ss from the
|
||||
# current seed to a byte-fixpoint and overwrites host/chez/seed/.
|
||||
set -e
|
||||
root="$(CDPATH= cd -- "$(dirname -- "$0")/../.." && pwd)"
|
||||
cd "$root"
|
||||
tmp="$(mktemp -d)"
|
||||
trap 'rm -rf "$tmp"' EXIT
|
||||
|
||||
cp host/chez/seed/prelude.ss "$tmp/cur-p.ss"
|
||||
cp host/chez/seed/image.ss "$tmp/cur-i.ss"
|
||||
i=0
|
||||
while [ "$i" -lt 8 ]; do
|
||||
i=$((i + 1))
|
||||
chez --script host/chez/bootstrap.ss \
|
||||
"$tmp/cur-p.ss" "$tmp/cur-i.ss" "$tmp/new-p.ss" "$tmp/new-i.ss" >/dev/null
|
||||
if diff -q "$tmp/cur-p.ss" "$tmp/new-p.ss" >/dev/null \
|
||||
&& diff -q "$tmp/cur-i.ss" "$tmp/new-i.ss" >/dev/null; then
|
||||
cp "$tmp/new-p.ss" host/chez/seed/prelude.ss
|
||||
cp "$tmp/new-i.ss" host/chez/seed/image.ss
|
||||
echo "re-minted seed (converged after $i pass(es))"
|
||||
exit 0
|
||||
fi
|
||||
cp "$tmp/new-p.ss" "$tmp/cur-p.ss"
|
||||
cp "$tmp/new-i.ss" "$tmp/cur-i.ss"
|
||||
done
|
||||
echo "re-mint did not converge in 8 passes" >&2
|
||||
exit 1
|
||||
210
host/chez/run-corpus.ss
Normal file
210
host/chez/run-corpus.ss
Normal file
|
|
@ -0,0 +1,210 @@
|
|||
;; run-corpus.ss — the standing correctness gate, pure Chez. NO Janet.
|
||||
;;
|
||||
;; Loads the checked-in seed (host/chez/seed/{prelude,image}.ss) + the zero-Janet
|
||||
;; spine, reads test/chez/corpus.edn, and for each row evaluates :actual and
|
||||
;; :expected through jolt-compile-eval and compares by value-equality (jolt=). The
|
||||
;; corpus :expected is JVM-sourced (test/conformance/regen-corpus.clj), so this
|
||||
;; measures jolt-on-Chez against reference Clojure.
|
||||
;;
|
||||
;; Each case runs as its own top-level program (a top-level do unrolls, so a macro
|
||||
;; defined earlier in the program is usable later), and mutable global state is
|
||||
;; reset between cases so there is no leakage — same isolation a fresh process gives.
|
||||
;;
|
||||
;; chez --script host/chez/run-corpus.ss
|
||||
;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2678)
|
||||
;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0)
|
||||
;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
|
||||
(import (chezscheme))
|
||||
|
||||
(load "host/chez/rt.ss")
|
||||
(set-chez-ns! "clojure.core")
|
||||
(load "host/chez/seed/prelude.ss")
|
||||
(load "host/chez/post-prelude.ss")
|
||||
(set-chez-ns! "user")
|
||||
(load "host/chez/host-contract.ss")
|
||||
(load "host/chez/seed/image.ss")
|
||||
(load "host/chez/compile-eval.ss")
|
||||
|
||||
(define (slurp path)
|
||||
(call-with-input-file path
|
||||
(lambda (p)
|
||||
(let loop ((cs '()) (c (read-char p)))
|
||||
(if (eof-object? c) (list->string (reverse cs))
|
||||
(loop (cons c cs) (read-char p)))))))
|
||||
|
||||
(define corpus (jolt-read-string (slurp "test/chez/corpus.edn")))
|
||||
(define kw-label (keyword #f "label"))
|
||||
(define kw-actual (keyword #f "actual"))
|
||||
(define kw-expected (keyword #f "expected"))
|
||||
(define kw-throws (keyword #f "throws"))
|
||||
|
||||
;; --- per-case isolation: snapshot the world after setup, restore it each case ----
|
||||
;; (1) var-table keys a case ADDS (its defs) are removed; (2) a base cell whose ROOT
|
||||
;; a case mutated (e.g. in-ns rebinds clojure.core/*ns*) is restored; (3) the ns +
|
||||
;; type registries are pruned to their base keys; (4) global-hierarchy's contents
|
||||
;; (mutated by derive) are reset to a fresh hierarchy.
|
||||
(define zj-base (let ((h (make-hashtable string-hash string=?)))
|
||||
(vector-for-each (lambda (k) (hashtable-set! h k #t)) (hashtable-keys var-table)) h))
|
||||
(define zj-roots '())
|
||||
(vector-for-each (lambda (k) (let ((c (hashtable-ref var-table k #f)))
|
||||
(when c (set! zj-roots (cons (cons c (var-cell-root c)) zj-roots)))))
|
||||
(hashtable-keys var-table))
|
||||
(define (zj-snap ht) (let ((h (make-hashtable string-hash string=?)))
|
||||
(vector-for-each (lambda (k) (hashtable-set! h k #t)) (hashtable-keys ht)) h))
|
||||
(define (zj-prune! ht base) (vector-for-each
|
||||
(lambda (k) (unless (hashtable-ref base k #f) (hashtable-delete! ht k))) (hashtable-keys ht)))
|
||||
(define zj-ns-base (zj-snap ns-registry))
|
||||
(define zj-type-base (zj-snap type-registry))
|
||||
(define zj-ghier (var-cell-lookup "clojure.core" "global-hierarchy"))
|
||||
(define (zj-reset!)
|
||||
(vector-for-each (lambda (k) (unless (hashtable-ref zj-base k #f) (hashtable-delete! var-table k)))
|
||||
(hashtable-keys var-table))
|
||||
(for-each (lambda (cr) (unless (eq? (var-cell-root (car cr)) (cdr cr))
|
||||
(var-cell-root-set! (car cr) (cdr cr)))) zj-roots)
|
||||
(zj-prune! ns-registry zj-ns-base)
|
||||
(zj-prune! type-registry zj-type-base)
|
||||
(hashtable-clear! ns-alias-table)
|
||||
(hashtable-clear! ns-refer-table)
|
||||
(when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!")
|
||||
(var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy"))))
|
||||
(set-chez-ns! "user"))
|
||||
|
||||
(define kw-message (keyword #f "message"))
|
||||
(define (zj-err->str e)
|
||||
(cond ((and (pmap? e) (string? (jolt-get e kw-message))) (jolt-get e kw-message))
|
||||
((condition? e) (call-with-string-output-port (lambda (p) (display-condition e p))))
|
||||
((string? e) e)
|
||||
(else (call-with-string-output-port (lambda (p) (write e p))))))
|
||||
(define (zj-clean s)
|
||||
(list->string (map (lambda (c) (if (or (char=? c #\tab) (char=? c #\newline)) #\space c))
|
||||
(string->list s))))
|
||||
|
||||
;; --- allowlist: conformance gaps vs the JVM spec (no JVM host on Chez) -----------
|
||||
;; Keyed by label. jolt does not match because it has no Class objects / Java arrays
|
||||
;; / BigDecimal, supports the :jolt reader-conditional, or prints its own forms for
|
||||
;; transients/atoms/Infinity. These DIVERGE but are tolerated; the gate fails only on
|
||||
;; a NEW (unlisted) divergence or a drop below the floor.
|
||||
(define known-fail-labels
|
||||
'("class name evaluates to canonical string"
|
||||
"class number" "class string" "class keyword"
|
||||
"definterface defines" "getMessage on a thrown string"
|
||||
"type of record" "chunked-seq? always false"
|
||||
"^Type tag on var" "symbol hint -> :tag"
|
||||
"lists extended type" "seq of tags"
|
||||
"close on throw" "macroexpand-1" "ns-imports empty user"
|
||||
"bean is the map" "proxy resolves nil" "unchecked-char"
|
||||
"*in* is bound" "*in* bound"
|
||||
"bigdec" "bigdec int M" "bigdec suffix M"
|
||||
"transient vector" "transient map"
|
||||
"atom override fires nested" "inf inside coll" "pr-str Infinity"
|
||||
"defmethod overrides a record, top level"
|
||||
"defmethod fires nested in a map" "defmethod fires through prn"
|
||||
"direct builtin override" "methods table inspectable"
|
||||
"reader conditional" "reader cond :jolt" "reader cond no match"
|
||||
"reader cond splice" "reader cond splice no match"
|
||||
"nil nested" "bool nested" "source order through syntax-quote"
|
||||
"make-array" "into-array" "to-array" "aclone vec"
|
||||
"boolean-array" "int-array" "long-array" "double-array"
|
||||
"float-array" "short-array" "doubles" "floats" "reader over char[]"
|
||||
"atom?" "instance? Atom"
|
||||
"cancel an in-flight future returns true" "future-cancelled? after cancel"
|
||||
"no param vector"))
|
||||
(define known-fail (make-hashtable string-hash string=?))
|
||||
(for-each (lambda (l) (hashtable-set! known-fail l #t)) known-fail-labels)
|
||||
|
||||
;; Cases that BLOCK forever on a shared-heap host (deref of an undelivered promise) —
|
||||
;; skip like :throws so one hung case can't stall the run.
|
||||
(define skip-blocking (make-hashtable string-hash string=?))
|
||||
(hashtable-set! skip-blocking "promise undelivered" #t)
|
||||
|
||||
;; Coarse crash bucket for the punch-list (informational; not gate-critical).
|
||||
(define (crash-reason m)
|
||||
(define (has? sub) (let loop ((i 0))
|
||||
(cond ((> (+ i (string-length sub)) (string-length m)) #f)
|
||||
((string=? (substring m i (+ i (string-length sub))) sub) #t)
|
||||
(else (loop (+ i 1))))))
|
||||
(cond ((has? "unsupported stdlib") "emit: unsupported stdlib fn")
|
||||
((has? "unsupported host") "emit: unsupported host call")
|
||||
((has? "host-static") "emit: host-static")
|
||||
((has? "uncompil") "analyzer: uncompilable")
|
||||
((has? "Unknown class") "runtime: unknown class")
|
||||
((has? "No constructor") "runtime: no constructor")
|
||||
((has? "No method") "runtime: no method")
|
||||
((has? "not a fn") "runtime: not a fn")
|
||||
((has? "not seqable") "runtime: not seqable")
|
||||
(else (substring m 0 (min 56 (string-length m))))))
|
||||
|
||||
;; --- run ------------------------------------------------------------------------
|
||||
(define limit (let ((s (getenv "JOLT_CORPUS_LIMIT")))
|
||||
(and s (string->number s))))
|
||||
(define stride (if (and limit (> limit 0)) (max 1 (quotient (pvec-count corpus) limit)) 1))
|
||||
|
||||
(define pass 0) (define throws 0)
|
||||
(define crashes '()) ; (label . reason)
|
||||
(define diverged '()) ; (label . got) — NEW divergence; gate fails
|
||||
(define known-hit '()) ; label
|
||||
(define crash-keys (make-hashtable string-hash string=?))
|
||||
(define (bucket! ht k) (hashtable-set! ht k (+ 1 (hashtable-ref ht k 0))))
|
||||
|
||||
(define t0 (current-time))
|
||||
(let loop ((i 0))
|
||||
(when (< i (pvec-count corpus))
|
||||
(let* ((row (pvec-nth-d corpus i jolt-nil))
|
||||
(label (jolt-get row kw-label))
|
||||
(ev-src (jolt-get row kw-expected))
|
||||
(av-src (jolt-get row kw-actual)))
|
||||
(cond
|
||||
((or (eq? ev-src kw-throws) (hashtable-ref skip-blocking label #f))
|
||||
(set! throws (+ throws 1)))
|
||||
(else
|
||||
(guard (e (#t (let ((r (crash-reason (zj-clean (zj-err->str e)))))
|
||||
(bucket! crash-keys r)
|
||||
(set! crashes (cons (cons label r) crashes)))))
|
||||
;; discard a case's own stdout (a (println ...) side effect) so it can't
|
||||
;; pollute the gate report — as if the case ran in its own process.
|
||||
(let* ((sink (open-output-string))
|
||||
(av (parameterize ((current-output-port sink)) (jolt-compile-eval av-src "user")))
|
||||
(ev (parameterize ((current-output-port sink)) (jolt-compile-eval ev-src "user"))))
|
||||
(cond
|
||||
((jolt= ev av) (set! pass (+ pass 1)))
|
||||
((hashtable-ref known-fail label #f) (set! known-hit (cons label known-hit)))
|
||||
(else (set! diverged (cons (cons label (zj-clean (jolt-final-str av))) diverged))))))
|
||||
(zj-reset!))))
|
||||
(loop (+ i stride))))
|
||||
|
||||
(define n-eval (+ pass (length crashes) (length diverged) (length known-hit)))
|
||||
(define secs (let ((d (time-difference (current-time) t0)))
|
||||
(+ (time-second d) (/ (time-nanosecond d) 1e9))))
|
||||
(printf "\nZero-Janet corpus parity: ~a/~a evaluated cases pass (~as)\n"
|
||||
pass n-eval (/ (round (* secs 10)) 10.0))
|
||||
(printf " crash: ~a NEW divergence: ~a known: ~a (throws skipped: ~a)\n"
|
||||
(length crashes) (length diverged) (length known-hit) throws)
|
||||
|
||||
(when (> (hashtable-size crash-keys) 0)
|
||||
(printf "\ncrash reasons:\n")
|
||||
(let-values (((ks vs) (hashtable-entries crash-keys)))
|
||||
(for-each (lambda (pair) (printf " ~a x ~a\n" (cdr pair) (car pair)))
|
||||
(list-sort (lambda (a b) (> (cdr a) (cdr b)))
|
||||
(vector->list (vector-map cons ks vs))))))
|
||||
(when (getenv "JOLT_DUMP_CRASH_LABELS")
|
||||
(printf "\nCRASH LABELS:\n")
|
||||
(for-each (lambda (p) (printf " [~a] :: ~a\n" (cdr p) (car p)))
|
||||
(list-sort (lambda (a b) (string<? (cdr a) (cdr b))) crashes))
|
||||
(printf "\nKNOWN-HIT LABELS:\n")
|
||||
(for-each (lambda (l) (printf " ~a\n" l)) (list-sort string<? known-hit)))
|
||||
(when (> (length diverged) 0)
|
||||
(printf "\nNEW divergences (ran, wrong value) — gate FAILS:\n")
|
||||
(for-each (lambda (p) (printf " [~a] got ~a\n" (car p) (cdr p)))
|
||||
(list-head diverged (min 40 (length diverged)))))
|
||||
(when (> (length known-hit) 0)
|
||||
(printf "\n~a known (allowlisted) failures tolerated.\n" (length known-hit)))
|
||||
|
||||
;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
|
||||
(define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR")))
|
||||
(if s (string->number s) 2678)))
|
||||
(define floor (if limit 0 base-floor))
|
||||
(when (or (> (length diverged) 0) (< pass floor))
|
||||
(printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"
|
||||
pass floor (length diverged)))
|
||||
(flush-output-port)
|
||||
(exit (if (or (> (length diverged) 0) (< pass floor)) 1 0))
|
||||
103
host/chez/run-unit.ss
Normal file
103
host/chez/run-unit.ss
Normal file
|
|
@ -0,0 +1,103 @@
|
|||
;; run-unit.ss — host-specific unit gate, pure Chez. NO Janet.
|
||||
;;
|
||||
;; Loads the checked-in seed + spine, reads test/chez/unit.edn, and for each case
|
||||
;; evaluates :expr (wrapped in (do ...), as `joltc -e` does) and compares its PRINTED
|
||||
;; value (jolt-final-str) to the literal :expected string. :expected :throws asserts
|
||||
;; the case raises. These cover host-specific behavior (dot-forms, java statics, io,
|
||||
;; reader, walk, …) that isn't in the JVM-portable corpus. Global state is reset
|
||||
;; between cases for per-case isolation.
|
||||
;;
|
||||
;; chez --script host/chez/run-unit.ss
|
||||
(import (chezscheme))
|
||||
|
||||
(load "host/chez/rt.ss")
|
||||
(set-chez-ns! "clojure.core")
|
||||
(load "host/chez/seed/prelude.ss")
|
||||
(load "host/chez/post-prelude.ss")
|
||||
(set-chez-ns! "user")
|
||||
(load "host/chez/host-contract.ss")
|
||||
(load "host/chez/seed/image.ss")
|
||||
(load "host/chez/compile-eval.ss")
|
||||
|
||||
(define (slurp path)
|
||||
(call-with-input-file path
|
||||
(lambda (p)
|
||||
(let loop ((cs '()) (c (read-char p)))
|
||||
(if (eof-object? c) (list->string (reverse cs))
|
||||
(loop (cons c cs) (read-char p)))))))
|
||||
|
||||
(define cases (jolt-read-string (slurp "test/chez/unit.edn")))
|
||||
(define kw-suite (keyword #f "suite"))
|
||||
(define kw-expr (keyword #f "expr"))
|
||||
(define kw-expected (keyword #f "expected"))
|
||||
(define kw-throws (keyword #f "throws"))
|
||||
|
||||
;; --- per-case isolation (snapshot the world after setup, restore each case) -------
|
||||
(define zj-base (let ((h (make-hashtable string-hash string=?)))
|
||||
(vector-for-each (lambda (k) (hashtable-set! h k #t)) (hashtable-keys var-table)) h))
|
||||
(define zj-roots '())
|
||||
(vector-for-each (lambda (k) (let ((c (hashtable-ref var-table k #f)))
|
||||
(when c (set! zj-roots (cons (cons c (var-cell-root c)) zj-roots)))))
|
||||
(hashtable-keys var-table))
|
||||
(define (zj-snap ht) (let ((h (make-hashtable string-hash string=?)))
|
||||
(vector-for-each (lambda (k) (hashtable-set! h k #t)) (hashtable-keys ht)) h))
|
||||
(define (zj-prune! ht base) (vector-for-each
|
||||
(lambda (k) (unless (hashtable-ref base k #f) (hashtable-delete! ht k))) (hashtable-keys ht)))
|
||||
(define zj-ns-base (zj-snap ns-registry))
|
||||
(define zj-type-base (zj-snap type-registry))
|
||||
(define zj-ghier (var-cell-lookup "clojure.core" "global-hierarchy"))
|
||||
(define (zj-reset!)
|
||||
(vector-for-each (lambda (k) (unless (hashtable-ref zj-base k #f) (hashtable-delete! var-table k)))
|
||||
(hashtable-keys var-table))
|
||||
(for-each (lambda (cr) (unless (eq? (var-cell-root (car cr)) (cdr cr))
|
||||
(var-cell-root-set! (car cr) (cdr cr)))) zj-roots)
|
||||
(zj-prune! ns-registry zj-ns-base)
|
||||
(zj-prune! type-registry zj-type-base)
|
||||
(hashtable-clear! ns-alias-table)
|
||||
(hashtable-clear! ns-refer-table)
|
||||
(when zj-ghier (jolt-invoke (var-deref "clojure.core" "reset!")
|
||||
(var-cell-root zj-ghier) (jolt-invoke (var-deref "clojure.core" "make-hierarchy"))))
|
||||
(set-chez-ns! "user"))
|
||||
|
||||
;; --- run ------------------------------------------------------------------------
|
||||
(define pass 0)
|
||||
(define fails '()) ; (suite expr msg)
|
||||
(define suite-pass (make-hashtable string-hash string=?))
|
||||
(define suite-total (make-hashtable string-hash string=?))
|
||||
(define (bump! ht k) (hashtable-set! ht k (+ 1 (hashtable-ref ht k 0))))
|
||||
|
||||
(let loop ((i 0))
|
||||
(when (< i (pvec-count cases))
|
||||
(let* ((row (pvec-nth-d cases i jolt-nil))
|
||||
(suite (jolt-get row kw-suite))
|
||||
(expr (jolt-get row kw-expr))
|
||||
(expected (jolt-get row kw-expected))
|
||||
(throws? (eq? expected kw-throws))
|
||||
(sink (open-output-string)))
|
||||
(bump! suite-total suite)
|
||||
(guard (e (#t (if throws?
|
||||
(begin (set! pass (+ pass 1)) (bump! suite-pass suite))
|
||||
(set! fails (cons (list suite expr "raised") fails)))))
|
||||
(let ((got (jolt-final-str
|
||||
(parameterize ((current-output-port sink))
|
||||
(jolt-compile-eval (string-append "(do " expr ")") "user")))))
|
||||
(cond
|
||||
(throws? (set! fails (cons (list suite expr (string-append "expected throw; got " got)) fails)))
|
||||
((string=? got expected) (begin (set! pass (+ pass 1)) (bump! suite-pass suite)))
|
||||
(else (set! fails (cons (list suite expr
|
||||
(string-append "want `" expected "` got `" got "`")) fails))))))
|
||||
(zj-reset!))
|
||||
(loop (+ i 1))))
|
||||
|
||||
(printf "\nunit gate: ~a/~a passed\n" pass (pvec-count cases))
|
||||
(let-values (((ks vs) (hashtable-entries suite-total)))
|
||||
(for-each (lambda (p)
|
||||
(printf " ~a/~a ~a\n" (hashtable-ref suite-pass (car p) 0) (cdr p) (car p)))
|
||||
(list-sort (lambda (a b) (string<? (car a) (car b)))
|
||||
(vector->list (vector-map cons ks vs)))))
|
||||
(when (> (length fails) 0)
|
||||
(printf "\n~a FAIL(s):\n" (length fails))
|
||||
(for-each (lambda (f) (printf " [~a] ~a\n ~a\n" (car f) (caddr f) (cadr f)))
|
||||
(list-head (reverse fails) (min 40 (length fails)))))
|
||||
(flush-output-port)
|
||||
(exit (if (> (length fails) 0) 1 0))
|
||||
18
host/chez/selfcheck.sh
Executable file
18
host/chez/selfcheck.sh
Executable file
|
|
@ -0,0 +1,18 @@
|
|||
#!/bin/sh
|
||||
# self-host fixpoint gate: bootstrap.ss rebuilds the prelude + compiler image from
|
||||
# source on pure Chez; the rebuild must equal the checked-in seed byte-for-byte. If
|
||||
# it doesn't, a seed source changed without a re-mint — run `make remint`.
|
||||
set -e
|
||||
root="$(CDPATH= cd -- "$(dirname -- "$0")/../.." && pwd)"
|
||||
cd "$root"
|
||||
tmp="$(mktemp -d)"
|
||||
trap 'rm -rf "$tmp"' EXIT
|
||||
chez --script host/chez/bootstrap.ss \
|
||||
host/chez/seed/prelude.ss host/chez/seed/image.ss "$tmp/p.ss" "$tmp/i.ss" >/dev/null
|
||||
if diff -q host/chez/seed/prelude.ss "$tmp/p.ss" >/dev/null \
|
||||
&& diff -q host/chez/seed/image.ss "$tmp/i.ss" >/dev/null; then
|
||||
echo "self-host fixpoint: rebuild == checked-in seed"
|
||||
else
|
||||
echo "self-host FAILED: bootstrap rebuild != checked-in seed; run 'make remint'" >&2
|
||||
exit 1
|
||||
fi
|
||||
36
host/chez/smoke.sh
Executable file
36
host/chez/smoke.sh
Executable file
|
|
@ -0,0 +1,36 @@
|
|||
#!/bin/sh
|
||||
# CLI smoke: exercise the real bin/joltc process end to end — core eval, runtime
|
||||
# eval/load-string, runtime defmacro, futures, and the numeric tower. The in-process
|
||||
# corpus/unit gates cover semantics in depth; this confirms the CLI entry itself.
|
||||
root="$(CDPATH= cd -- "$(dirname -- "$0")/../.." && pwd)"
|
||||
cd "$root"
|
||||
|
||||
fails=0
|
||||
check() {
|
||||
got="$(bin/joltc -e "$1" 2>/dev/null | tail -1)"
|
||||
if [ "$got" = "$2" ]; then
|
||||
pass=$((pass + 1))
|
||||
else
|
||||
echo " FAIL: $1"
|
||||
echo " want \`$2\` got \`$got\`"
|
||||
fails=$((fails + 1))
|
||||
fi
|
||||
}
|
||||
pass=0
|
||||
|
||||
check '(+ 1 2)' '3'
|
||||
check '(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 15)' '610'
|
||||
check '(->> (range 10) (filter even?) (map (fn [x] (* x x))) (reduce +))' '120'
|
||||
check '(let [{:keys [a b] :or {b 99}} {:a 1}] [a b])' '[1 99]'
|
||||
check '(map inc [1 2 3])' '(2 3 4)'
|
||||
check '(require [clojure.string :as s]) (s/upper-case "hello")' 'HELLO'
|
||||
check '(eval (quote (+ 1 2)))' '3'
|
||||
check '(load-string "(def y 5) (* y y)")' '25'
|
||||
check '(defmacro add1 [x] (list (quote +) x 1)) (add1 10)' '11'
|
||||
check '(deref (future (+ 1 2)))' '3'
|
||||
check '(/ 1 2)' '1/2'
|
||||
check '(= 3 3.0)' 'false'
|
||||
check '(== 3 3.0)' 'true'
|
||||
|
||||
echo "cli smoke: $pass passed, $fails failed"
|
||||
[ "$fails" -eq 0 ]
|
||||
Loading…
Add table
Add a link
Reference in a new issue