giles
c07ff90f6b
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
59 lines
1.4 KiB
Plaintext
59 lines
1.4 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})))))
|