giles
d523df30c2
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m4s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
77 lines
2.1 KiB
Plaintext
77 lines
2.1 KiB
Plaintext
;; Shared test harness for Haskell-on-SX tests.
|
|
;; Each test file expects hk-test / hk-deep=? / counters to already be bound.
|
|
|
|
(define
|
|
hk-deep=?
|
|
(fn
|
|
(a b)
|
|
(cond
|
|
((= a b) true)
|
|
((and (dict? a) (dict? b))
|
|
(let
|
|
((ak (keys a)) (bk (keys b)))
|
|
(if
|
|
(not (= (len ak) (len bk)))
|
|
false
|
|
(every?
|
|
(fn
|
|
(k)
|
|
(and (has-key? b k) (hk-deep=? (get a k) (get b k))))
|
|
ak))))
|
|
((and (list? a) (list? b))
|
|
(if
|
|
(not (= (len a) (len b)))
|
|
false
|
|
(let
|
|
((i 0) (ok true))
|
|
(define
|
|
hk-de-loop
|
|
(fn
|
|
()
|
|
(when
|
|
(and ok (< i (len a)))
|
|
(do
|
|
(when
|
|
(not (hk-deep=? (nth a i) (nth b i)))
|
|
(set! ok false))
|
|
(set! i (+ i 1))
|
|
(hk-de-loop)))))
|
|
(hk-de-loop)
|
|
ok)))
|
|
(:else false))))
|
|
|
|
(define hk-test-pass 0)
|
|
(define hk-test-fail 0)
|
|
(define hk-test-fails (list))
|
|
|
|
(define
|
|
hk-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(hk-deep=? actual expected)
|
|
(set! hk-test-pass (+ hk-test-pass 1))
|
|
(do
|
|
(set! hk-test-fail (+ hk-test-fail 1))
|
|
(append!
|
|
hk-test-fails
|
|
{:actual actual :expected expected :name name})))))
|
|
|
|
(define
|
|
hk-test-error
|
|
(fn
|
|
(name thunk expected-substring)
|
|
(let
|
|
((caught (guard (e (true (if (string? e) e (str e)))) (begin (thunk) nil))))
|
|
(cond
|
|
((nil? caught)
|
|
(do
|
|
(set! hk-test-fail (+ hk-test-fail 1))
|
|
(append! hk-test-fails {:actual "no error raised" :expected (str "error containing: " expected-substring) :name name})))
|
|
((>= (index-of caught expected-substring) 0)
|
|
(set! hk-test-pass (+ hk-test-pass 1)))
|
|
(:else
|
|
(do
|
|
(set! hk-test-fail (+ hk-test-fail 1))
|
|
(append! hk-test-fails {:actual caught :expected (str "error containing: " expected-substring) :name name})))))))
|