From 18663e306cf1685802d1863f99777c7c1f2e950f Mon Sep 17 00:00:00 2001 From: Claude Date: Mon, 14 Sep 2026 07:30:47 +0000 Subject: [PATCH 1/2] =?UTF-8?q?=E3=83=89=E3=82=AD=E3=83=A5=E3=83=A1?= =?UTF-8?q?=E3=83=B3=E3=83=88=E3=81=AE=E7=84=A1=E3=81=84=E3=82=B3=E3=83=BC?= =?UTF-8?q?=E3=83=89=E3=81=A7=E7=94=9F=E6=88=90=E5=99=A8=E3=81=8C=E8=90=BD?= =?UTF-8?q?=E3=81=A1=E3=82=8B=E3=81=AE=E3=82=92=E7=9B=B4=E3=81=99?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit src/Code.hs には `\(X.Enumeration v docs) -> Code {...}` という同じラムダが 4 回書かれていた。うち 1 つは `constraintToCode` という名前の付いた トップレベル関数で、`Enumeration v []` を最初の等式で処理していて全域。 もう 1 つは `if not (null docs_)` でガードしてあり、これも全域。残る 2 つ (Code.hs:129 と Code.hs:178) は **ガード無しで `head docs_` と `last docs_` を呼んでいた**。 in Code {value = v, codeDescription = head docs_, notes = last docs_} `` のようにドキュメントを持たない列挙値が 1 つでもこの経路に来ると、生成器が `Prelude.head: empty list` で落ちる。 空の docs が実在することは、同じファイルの `constraintToCode` がわざわざ `Enumeration v []` を明示的に処理していることが示している。 3 つのインラインのラムダをすべて `constraintToCode` の呼び出しに置き換える。 同じ式は既にこのファイルの 2 箇所 (`map constraintToCode (typeConstraints t)` と `map constraintToCode simpleRestrictionConstraints`) で使われている。 ガード済みのものと `constraintToCode` は完全に等価なので、現在パースできて いるスキーマに対する生成結果は変わらない。変わるのは、これまで落ちていた 入力に対して `""` を返すようになる点だけ。 回帰テストを足す。fixtures/test_code_undocumented*.xsd は test_code_description*.xsd のコピーで、"02" の列挙から `` を 取り除いただけ。この差分だけで、修正前は `head` が空リストで落ちる。 parseConstrains は `value` 属性しか要求せず、annotation が無ければ parseAnnotations が `[]` を返すので、`Enumeration "02" []` になる。 -Wx-partial が src/ で報告する 5 箇所のうち、残る 3 箇所 (Code.hs:108 のガード済み、Code.hs:200 の `constraintToCode` 本体、 Model.hs:150 の `tail ys`) はいずれも偽陽性なので触っていない。 Co-Authored-By: Claude Opus 5 Claude-Session: https://claude.ai/code/session_01P8rZakwAiz1jpViUX34x1Z --- fixtures/test_code_undocumented.xsd | 14 ++++++++++ fixtures/test_code_undocumented_codelists.xsd | 20 +++++++++++++ src/Code.hs | 28 ++----------------- test/TestCode.hs | 17 +++++++++++ 4 files changed, 54 insertions(+), 25 deletions(-) create mode 100644 fixtures/test_code_undocumented.xsd create mode 100644 fixtures/test_code_undocumented_codelists.xsd diff --git a/fixtures/test_code_undocumented.xsd b/fixtures/test_code_undocumented.xsd new file mode 100644 index 0000000..83dff56 --- /dev/null +++ b/fixtures/test_code_undocumented.xsd @@ -0,0 +1,14 @@ + + + + + + + + + + + + + + diff --git a/fixtures/test_code_undocumented_codelists.xsd b/fixtures/test_code_undocumented_codelists.xsd new file mode 100644 index 0000000..c3a88f2 --- /dev/null +++ b/fixtures/test_code_undocumented_codelists.xsd @@ -0,0 +1,20 @@ + + + + + Name code type + + + + + Proprietary + Note that <IDTypeName> is required with proprietary identifiers + + + + + + + diff --git a/src/Code.hs b/src/Code.hs index fb27053..35b0ddb 100644 --- a/src/Code.hs +++ b/src/Code.hs @@ -101,15 +101,7 @@ topLevelTypeToCode _scm (ref, X.TypeSimple (X.AtomicType restriction annotations where description = T.intercalate ". " . map (\(X.Documentation x) -> x) $ annotations constraints = X.simpleRestrictionConstraints restriction - codes = - map - ( \(X.Enumeration v docs) -> - let docs_ = map (\(X.Documentation d) -> d) docs - codeDescription = if not (null docs_) then head docs_ else "" - notes = if not (null docs_) then last docs_ else "" - in Code {value = v, codeDescription = codeDescription, notes = notes} - ) - constraints + codes = map constraintToCode constraints topLevelTypeToCode scm (ref, X.TypeSimple (X.ListType ty _)) = case ty of X.Ref key_ -> @@ -122,13 +114,7 @@ topLevelTypeToCode scm (ref, X.TypeSimple (X.ListType ty _)) = _ -> False desc = (T.intercalate ". " . map (\(X.Documentation x) -> x) . typeAnnotations) t constraints = typeConstraints t - codes_ = - map - ( \(X.Enumeration v docs) -> - let docs_ = map (\(X.Documentation d) -> d) docs - in Code {value = v, codeDescription = head docs_, notes = last docs_} - ) - constraints + codes_ = map constraintToCode constraints refname = X.qnName ref in CodeType { xmlReferenceName = refname, @@ -170,15 +156,7 @@ topLevelElementToCode scm elm = Nothing -> pack "" codes_ = case ty of Just t -> - let constraints = typeConstraints t - enums = - map - ( \(X.Enumeration v docs) -> - let docs_ = map (\(X.Documentation d) -> d) docs - in Code {value = v, codeDescription = head docs_, notes = last docs_} - ) - constraints - in enums + map constraintToCode (typeConstraints t) Nothing -> [] refname = unwrap $ findFixedOf "refname" plainContentAttributes elements = diff --git a/test/TestCode.hs b/test/TestCode.hs index 52586dc..4be541a 100644 --- a/test/TestCode.hs +++ b/test/TestCode.hs @@ -37,6 +37,23 @@ tests = [] assertEqual "can derive description from type" expected actual ), + TestCase + ( do + scm <- getSchema "./fixtures/test_code_undocumented.xsd" + let actual = (topLevelElementToCode scm . head . collectCodes) scm + expected = + CodeType + "AddresseeIDType" + "Name code type" + ( V.fromList + [ Code "01" "Proprietary" "Note that is required with proprietary identifiers", + Code "02" "" "" + ] + ) + False + [] + assertEqual "codes without documentation do not crash the generator" expected actual + ), TestCase ( do scm <- getSchema "./fixtures/test_code_territorycodelist.xsd" From f5d2b7ec394988b6cf4632af6cee9bb769b1540f Mon Sep 17 00:00:00 2001 From: Claude Date: Mon, 14 Sep 2026 07:45:41 +0000 Subject: [PATCH 2/2] =?UTF-8?q?L129=20=E5=81=B4=E3=81=AB=E3=82=82=E5=9B=9E?= =?UTF-8?q?=E5=B8=B0=E3=83=86=E3=82=B9=E3=83=88=E3=82=92=E8=B6=B3=E3=81=99?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit レビュー指摘。落ちうる 2 箇所のうち、先の回帰テストは L178 (topLevelElementToCode の経路) しか通っていなかった。L129 (topLevelTypeToCode の ListType 分岐) は無防備なまま。 fixtures/test_code_territorycodelist*.xsd が既にその経路を踏んでいるので、 その undocumented 版を足して 1 ケースで塞ぐ。差分は "02" の列挙から を取り除いただけ。 Co-Authored-By: Claude Opus 5 Claude-Session: https://claude.ai/code/session_01P8rZakwAiz1jpViUX34x1Z --- ...st_code_territorycodelist_undocumented.xsd | 17 +++++++++++++++++ ...rritorycodelist_undocumented_codelists.xsd | 19 +++++++++++++++++++ test/TestCode.hs | 17 +++++++++++++++++ 3 files changed, 53 insertions(+) create mode 100644 fixtures/test_code_territorycodelist_undocumented.xsd create mode 100644 fixtures/test_code_territorycodelist_undocumented_codelists.xsd diff --git a/fixtures/test_code_territorycodelist_undocumented.xsd b/fixtures/test_code_territorycodelist_undocumented.xsd new file mode 100644 index 0000000..94c3d7e --- /dev/null +++ b/fixtures/test_code_territorycodelist_undocumented.xsd @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + + diff --git a/fixtures/test_code_territorycodelist_undocumented_codelists.xsd b/fixtures/test_code_territorycodelist_undocumented_codelists.xsd new file mode 100644 index 0000000..f3ceb05 --- /dev/null +++ b/fixtures/test_code_territorycodelist_undocumented_codelists.xsd @@ -0,0 +1,19 @@ + + + + + Name code type + + + + + Proprietary + Note that <IDTypeName> is required with proprietary identifiers + + + + + + + diff --git a/test/TestCode.hs b/test/TestCode.hs index 4be541a..871ccaa 100644 --- a/test/TestCode.hs +++ b/test/TestCode.hs @@ -71,6 +71,23 @@ tests = [] assertEqual "can parse territory code list" expected actual ), + TestCase + ( do + scm <- getSchema "./fixtures/test_code_territorycodelist_undocumented.xsd" + let actual = (topLevelTypeToCode scm . head . collectTypes) scm + expected = + CodeType + "TerritoryCodeList" + "Name code type" + ( V.fromList + [ Code "01" "Proprietary" "Note that is required with proprietary identifiers", + Code "02" "" "" + ] + ) + False + [] + assertEqual "codes without documentation do not crash the list-type branch" expected actual + ), TestCase ( do scm <- getSchema "./fixtures/test_code_space_separated.xsd"