giles
60a8eb24e0
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
60 lines
2.5 KiB
Plaintext
60 lines
2.5 KiB
Plaintext
;; class.sx — tests for class/instance parsing and evaluation.
|
|
|
|
(define prog-class1 (hk-core "class MyEq a where\n myEq :: a -> a -> Bool"))
|
|
(define prog-inst1 (hk-core "instance MyEq Int where\n myEq x y = x == y"))
|
|
|
|
;; ─── class-decl AST ───────────────────────────────────────────────────────────
|
|
(define cd1 (first (nth prog-class1 1)))
|
|
(hk-test "class-decl tag" (first cd1) "class-decl")
|
|
(hk-test "class-decl name" (nth cd1 1) "MyEq")
|
|
(hk-test "class-decl tvar" (nth cd1 2) "a")
|
|
(hk-test "class-decl methods" (len (nth cd1 3)) 1)
|
|
|
|
;; ─── instance-decl AST ────────────────────────────────────────────────────────
|
|
(define id1 (first (nth prog-inst1 1)))
|
|
(hk-test "instance-decl tag" (first id1) "instance-decl")
|
|
(hk-test "instance-decl class" (nth id1 1) "MyEq")
|
|
(hk-test "instance-decl type tag" (first (nth id1 2)) "t-con")
|
|
(hk-test "instance-decl type name" (nth (nth id1 2) 1) "Int")
|
|
(hk-test "instance-decl method count" (len (nth id1 3)) 1)
|
|
|
|
;; ─── eval: instance dict is built ────────────────────────────────────────────
|
|
(define
|
|
prog-full
|
|
(hk-core
|
|
"class MyEq a where\n myEq :: a -> a -> Bool\ninstance MyEq Int where\n myEq x y = x == y"))
|
|
(define env-full (hk-eval-program prog-full))
|
|
|
|
(hk-test "instance dict in env" (has-key? env-full "dictMyEq_Int") true)
|
|
|
|
(hk-test
|
|
"instance dict has method"
|
|
(has-key? (get env-full "dictMyEq_Int") "myEq")
|
|
true)
|
|
|
|
(hk-test
|
|
"dispatch: single-arg method works"
|
|
(hk-deep-force
|
|
(hk-run
|
|
"class Describable a where\n describe :: a -> String\ninstance Describable Int where\n describe x = \"an integer\"\nmain = describe 42"))
|
|
"an integer")
|
|
|
|
(hk-test
|
|
"dispatch: second instance (Bool)"
|
|
(hk-deep-force
|
|
(hk-run
|
|
"class Describable a where\n describe :: a -> String\ninstance Describable Bool where\n describe x = \"a boolean\"\ninstance Describable Int where\n describe x = \"an integer\"\nmain = describe True"))
|
|
"a boolean")
|
|
|
|
(hk-test
|
|
"dispatch: error on unknown instance"
|
|
(guard
|
|
(e (true (>= (index-of e "No instance") 0)))
|
|
(begin
|
|
(hk-deep-force
|
|
(hk-run
|
|
"class Describable a where\n describe :: a -> String\nmain = describe 42"))
|
|
false))
|
|
true)
|
|
|
|
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} |