From 7a6d61b77d07146abce730ada74674ebd944d9a6 Mon Sep 17 00:00:00 2001 From: kogai Date: Mon, 14 Sep 2026 02:27:05 +0000 Subject: [PATCH] Make two tests use the fixture they load MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Adding -Wall to the test suite in #66 surfaced these: both bound `scm <- getSchema ...` and never touched it, because they called typeToText on a hand-written AST literal instead. scm <- getSchema "./fixtures/test_model_atomic.xsd" let actual = typeToText expected1 -- the literal, not scm So each read a fixture and asserted nothing about it. They were fine as unit tests of typeToText, but the fixture in the name was decorative, and a parser regression could not have failed them. Feed typeToText the parsed type instead. The assertions are unchanged, and they still hold: typeToText reads only the restriction base, so NonEmptyString's minLength does not affect it, and nameForTest extends List82 with refname fixed to BibleContents, which is the branch that returns the refname. No duplicate parse assertion is added — TestModel already checks expected1 and expected4 against the same two fixtures a few cases earlier, which is also what confirms the literals match what parsing produces. Also drop a dead `key` binding in the mixed-HTML case, the third thing -Wall pointed at. Co-Authored-By: Claude Opus 5 Claude-Session: https://claude.ai/code/session_01P8rZakwAiz1jpViUX34x1Z --- test/TestModel.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/test/TestModel.hs b/test/TestModel.hs index 9f52bf6..25f8ee7 100644 --- a/test/TestModel.hs +++ b/test/TestModel.hs @@ -121,7 +121,7 @@ tests = TestCase ( do scm <- getSchema "./fixtures/test_model_atomic.xsd" - let actual = typeToText expected1 + let actual = (typeToText . unwrap . M.lookup (makeTargetQName "NonEmptyString") . schemaTypes) scm assertEqual "can derive string type" "string" actual ), TestCase @@ -145,7 +145,7 @@ tests = TestCase ( do scm <- getSchema "./fixtures/test_model_atom_ref_bylist.xsd" - let actual = typeToText expected4 + let actual = (typeToText . unwrap . M.lookup (makeTargetQName "nameForTest") . schemaTypes) scm assertEqual "can derive referenced type" "BibleContents" actual ), TestCase @@ -200,8 +200,7 @@ tests = TestCase ( do scm <- getSchema "./fixtures/test_mixed_html.xsd" - let key = makeTargetQName "Annotation" - actual = collectElements scm + let actual = collectElements scm assertEqual "can parse choice of html string" [] actual ), TestCase