giles
bb134b88e3
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
141 lines
3.7 KiB
Plaintext
141 lines
3.7 KiB
Plaintext
;; show.sx — tests for the Show / Read class plumbing.
|
|
;;
|
|
;; Covers Phase 8:
|
|
;; - showsPrec / showParen / shows / showString stubs
|
|
;; - Read class stubs (reads / readsPrec / read)
|
|
;; - direct show coverage (Int, Bool, String, list, tuple, Maybe, ADT, ...)
|
|
|
|
;; ── ShowS / showsPrec / showParen stubs ──────────────────────
|
|
(hk-test
|
|
"shows: prepends show output"
|
|
(hk-deep-force (hk-run "main = shows 5 \"abc\""))
|
|
"5abc")
|
|
|
|
(hk-test
|
|
"shows: works on True"
|
|
(hk-deep-force (hk-run "main = shows True \"x\""))
|
|
"Truex")
|
|
|
|
(hk-test
|
|
"showString: prepends literal"
|
|
(hk-deep-force (hk-run "main = showString \"hello\" \" world\""))
|
|
"hello world")
|
|
|
|
(hk-test
|
|
"showParen True: wraps inner output in parens"
|
|
(hk-deep-force (hk-run "main = showParen True (showString \"inside\") \"\""))
|
|
"(inside)")
|
|
|
|
(hk-test
|
|
"showParen False: passes through unchanged"
|
|
(hk-deep-force (hk-run "main = showParen False (showString \"inside\") \"\""))
|
|
"inside")
|
|
|
|
(hk-test
|
|
"showsPrec: prepends show output regardless of prec"
|
|
(hk-deep-force (hk-run "main = showsPrec 11 42 \"end\""))
|
|
"42end")
|
|
|
|
(hk-test
|
|
"showParen + manual composition: build (Just 3)"
|
|
(hk-deep-force
|
|
(hk-run
|
|
"buildJust3 s = showString \"Just \" (shows 3 s)\nmain = showParen True buildJust3 \"\""))
|
|
"(Just 3)")
|
|
|
|
;; ── Read stubs ───────────────────────────────────────────────
|
|
(hk-test
|
|
"reads: stub returns empty list (null-check)"
|
|
(hk-deep-force (hk-run "main = show (null (reads \"42\"))"))
|
|
"True")
|
|
|
|
(hk-test
|
|
"readsPrec: stub returns empty list"
|
|
(hk-deep-force (hk-run "main = show (null (readsPrec 0 \"True\"))"))
|
|
"True")
|
|
|
|
(hk-test
|
|
"reads: type-checks in expression context (length)"
|
|
(hk-deep-force (hk-run "main = show (length (reads \"abc\"))"))
|
|
"0")
|
|
|
|
;; ── Direct `show` audit coverage ─────────────────────────────
|
|
(hk-test "show Int" (hk-deep-force (hk-run "main = show 42")) "42")
|
|
|
|
(hk-test
|
|
"show negative Int"
|
|
(hk-deep-force (hk-run "main = show (negate 5)"))
|
|
"-5")
|
|
|
|
(hk-test "show Bool True" (hk-deep-force (hk-run "main = show True")) "True")
|
|
|
|
(hk-test
|
|
"show Bool False"
|
|
(hk-deep-force (hk-run "main = show False"))
|
|
"False")
|
|
|
|
(hk-test
|
|
"show String quotes the value"
|
|
(hk-deep-force (hk-run "main = show \"hello\""))
|
|
"\"hello\"")
|
|
|
|
(hk-test
|
|
"show list of Int"
|
|
(hk-deep-force (hk-run "main = show [1,2,3]"))
|
|
"[1,2,3]")
|
|
|
|
(hk-test
|
|
"show empty list"
|
|
(hk-deep-force (hk-run "main = show (drop 5 [1,2,3])"))
|
|
"[]")
|
|
|
|
(hk-test
|
|
"show pair tuple"
|
|
(hk-deep-force (hk-run "main = show (1, True)"))
|
|
"(1,True)")
|
|
|
|
(hk-test
|
|
"show triple tuple"
|
|
(hk-deep-force (hk-run "main = show (1, 2, 3)"))
|
|
"(1,2,3)")
|
|
|
|
(hk-test
|
|
"show Maybe Nothing"
|
|
(hk-deep-force (hk-run "main = show Nothing"))
|
|
"Nothing")
|
|
|
|
(hk-test
|
|
"show Maybe Just"
|
|
(hk-deep-force (hk-run "main = show (Just 3)"))
|
|
"Just 3")
|
|
|
|
(hk-test
|
|
"show nested Just wraps inner in parens"
|
|
(hk-deep-force (hk-run "main = show (Just (Just 3))"))
|
|
"Just (Just 3)")
|
|
|
|
(hk-test
|
|
"show Just (negate 3) wraps negative in parens"
|
|
(hk-deep-force (hk-run "main = show (Just (negate 3))"))
|
|
"Just (-3)")
|
|
|
|
(hk-test
|
|
"show custom nullary ADT"
|
|
(hk-deep-force
|
|
(hk-run "data Day = Mon | Tue | Wed deriving (Show)\nmain = show Tue"))
|
|
"Tue")
|
|
|
|
(hk-test
|
|
"show custom multi-constructor ADT"
|
|
(hk-deep-force
|
|
(hk-run
|
|
"data Shape = Pt | Sq Int | Rect Int Int deriving (Show)\nmain = show (Rect 3 4)"))
|
|
"Rect 3 4")
|
|
|
|
(hk-test
|
|
"show list of Maybe wraps each element"
|
|
(hk-deep-force (hk-run "main = show [Just 1, Nothing, Just 2]"))
|
|
"[Just 1,Nothing,Just 2]")
|
|
|
|
{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
|