Skip to content

Commit 3748b8e

Browse files
Smaug123claude
andcommitted
Use exactly the scanner's equality in schema validation
ToUpperInvariant keying is strictly coarser than OrdinalIgnoreCase (the equality the scanner matches keys with): "s" and "ſ" uppercase to the same string but are distinct keys, so the checked constructor falsely rejected schemas the scanner routes unambiguously. Group claims with StringComparer.OrdinalIgnoreCase instead. Also reject forms no token can ever address: an empty form (its token is the positional separator) and forms containing '=' (a --key=value token splits at its first '='), either of which could otherwise leave a required argument, or a whole union case, permanently unsatisfiable. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
1 parent e9c5f43 commit 3748b8e

2 files changed

Lines changed: 125 additions & 7 deletions

File tree

WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParserRuntime.fs

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1275,3 +1275,57 @@ module TestArgParserRuntime =
12751275

12761276
let config = Config.QuickThrowOnFailure.WithMaxTest 500
12771277
Check.One (config, Prop.forAll (Arb.fromGen cases) property)
1278+
1279+
[<Test>]
1280+
let ``Collision detection uses exactly the scanner's equality`` () =
1281+
// "s" and "ſ" (long s) uppercase to the same string, but OrdinalIgnoreCase — the equality
1282+
// the scanner matches keys with — considers them distinct. A coarser normalisation (e.g.
1283+
// ToUpperInvariant keying) would falsely reject this schema even though the scanner
1284+
// routes its tokens unambiguously.
1285+
let schema =
1286+
productSchema
1287+
[
1288+
leaf 0 "s" ErasedArity.One ErasedRequirement.Required
1289+
leaf 1 "ſ" ErasedArity.One ErasedRequirement.Required
1290+
]
1291+
None
1292+
1293+
// The scanner really does distinguish them.
1294+
scan schema [ "--s=1" ] |> shouldEqual [ occ 0 (Some "1") false "--s=1" ]
1295+
scan schema [ "--ſ=1" ] |> shouldEqual [ occ 1 (Some "1") false "--ſ=1" ]
1296+
1297+
WellFormedSchema.errors schema |> shouldEqual []
1298+
1299+
[<Test>]
1300+
let ``An empty form is rejected: its token would be the separator`` () =
1301+
let bad =
1302+
{ leaf 0 "a" ErasedArity.One ErasedRequirement.Required with
1303+
Forms = [ "" ]
1304+
}
1305+
1306+
WellFormedSchema.errors (productSchema [ bad ] None)
1307+
|> shouldEqual [ SchemaError.EmptyForm "argument id 0" ]
1308+
1309+
[<Test>]
1310+
let ``A form containing an equals sign is rejected: the scanner splits at the first equals`` () =
1311+
// A required argument under such a form would make its schema (or its union case)
1312+
// permanently unsatisfiable, while still passing every name-collision check.
1313+
let bad =
1314+
{ leaf 0 "a" ErasedArity.One ErasedRequirement.Required with
1315+
Forms = [ "foo=bar" ]
1316+
}
1317+
1318+
WellFormedSchema.errors (productSchema [ bad ] None)
1319+
|> shouldEqual [ SchemaError.FormContainsEquals ("argument id 0", "foo=bar") ]
1320+
1321+
let badSink =
1322+
{
1323+
Id = 99
1324+
Form = "rest=stuff"
1325+
FlagLike = ErasedFlagLikeBehaviour.Reject
1326+
TypeDescription = "string"
1327+
Help = None
1328+
}
1329+
1330+
WellFormedSchema.errors (productSchema [ leaf 0 "a" ErasedArity.One ErasedRequirement.Required ] (Some badSink))
1331+
|> shouldEqual [ SchemaError.FormContainsEquals ("the positional-args sink", "rest=stuff") ]

WoofWare.Myriad.Plugins/ArgParserRuntime.fs

Lines changed: 71 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -604,6 +604,13 @@ module internal ArgParserRuntime =
604604
| NoForms of leafId : int
605605
/// A leaf accepts `--no-` negation but is not boolean-like.
606606
| NegationOnNonBool of leafId : int
607+
/// A form is the empty string: its token would be `--`, which the scanner always
608+
/// treats as the positional separator, so the argument could never be addressed.
609+
| EmptyForm of claimant : string
610+
/// A form contains an equals sign: the scanner splits a `--key=value` token at its
611+
/// *first* `=`, so such a form can never match. An argument required under such a form
612+
/// makes the schema (or a union case of it) permanently unsatisfiable.
613+
| FormContainsEquals of claimant : string * form : string
607614
/// Two distinct claimants respond to the same `--token` under the scanner's
608615
/// case-insensitive matching (so e.g. forms `foo` and `FOO` collide, as do a literal
609616
/// form `no-foo` and the negated variant of a negatable `foo`). The token is reported
@@ -627,6 +634,13 @@ module internal ArgParserRuntime =
627634
| SchemaError.NoForms leafId -> sprintf "argument id %i has no names" leafId
628635
| SchemaError.NegationOnNonBool leafId ->
629636
sprintf "argument id %i accepts --no- negation but is not boolean-like" leafId
637+
| SchemaError.EmptyForm claimant ->
638+
sprintf "%s has an empty name: its token would be '--', which is the positional separator" claimant
639+
| SchemaError.FormContainsEquals (claimant, form) ->
640+
sprintf
641+
"%s has the name '%s', which contains '='; a --key=value token splits at its first '=', so this argument could never be addressed"
642+
claimant
643+
form
630644
| SchemaError.TokenCollision (token, claimants) ->
631645
sprintf
632646
"the token '%s' is claimed by: %s (argument names are matched case-insensitively)"
@@ -733,14 +747,63 @@ module internal ArgParserRuntime =
733747
)
734748
@ [ "--help", "the built-in help flag" ]
735749

750+
// Group under the scanner's own equality (OrdinalIgnoreCase), preserving
751+
// declaration order. This is deliberately not ToUpperInvariant keying, which is a
752+
// strictly coarser relation: e.g. "s" and "ſ" (long s) uppercase to the same string,
753+
// but the scanner considers them distinct, so they do not collide.
736754
let collisions =
737-
claims
738-
|> List.groupBy (fun (token, _) -> token.ToUpperInvariant ())
739-
|> List.choose (fun (_, group) ->
740-
match group with
741-
| []
742-
| [ _ ] -> None
743-
| (token, _) :: _ -> Some (SchemaError.TokenCollision (token, group |> List.map snd))
755+
let indexOf =
756+
System.Collections.Generic.Dictionary<string, int> (StringComparer.OrdinalIgnoreCase)
757+
758+
let buckets = ResizeArray<ResizeArray<string * string>> ()
759+
760+
for token, claimant in claims do
761+
match indexOf.TryGetValue token with
762+
| true, index -> buckets.[index].Add ((token, claimant))
763+
| false, _ ->
764+
indexOf.[token] <- buckets.Count
765+
let bucket = ResizeArray ()
766+
bucket.Add ((token, claimant))
767+
buckets.Add bucket
768+
769+
buckets
770+
|> Seq.choose (fun bucket ->
771+
if bucket.Count < 2 then
772+
None
773+
else
774+
let token, _ = bucket.[0]
775+
Some (SchemaError.TokenCollision (token, bucket |> Seq.map snd |> List.ofSeq))
776+
)
777+
|> List.ofSeq
778+
779+
// Forms which no token could ever address, because of how the scanner tokenises.
780+
let unaddressable =
781+
(schema.Leaves
782+
|> List.collect (fun leaf ->
783+
let claimant = sprintf "argument id %i" leaf.Id
784+
785+
leaf.Forms
786+
|> List.collect (fun form ->
787+
if form = "" then
788+
[ SchemaError.EmptyForm claimant ]
789+
elif form.Contains "=" then
790+
[ SchemaError.FormContainsEquals (claimant, form) ]
791+
else
792+
[]
793+
)
794+
))
795+
@ (
796+
match schema.Positional with
797+
| None -> []
798+
| Some positional ->
799+
let claimant = "the positional-args sink"
800+
801+
if positional.Form = "" then
802+
[ SchemaError.EmptyForm claimant ]
803+
elif positional.Form.Contains "=" then
804+
[ SchemaError.FormContainsEquals (claimant, positional.Form) ]
805+
else
806+
[]
744807
)
745808

746809
duplicateLeafIds
@@ -750,6 +813,7 @@ module internal ArgParserRuntime =
750813
@ duplicateSumIds
751814
@ noForms
752815
@ negationOnNonBool
816+
@ unaddressable
753817
@ collisions
754818

755819
/// Check the invariants which the scanning and selection semantics rely on.

0 commit comments

Comments
 (0)