Automate the discriminated-union generation-rejection tests

Cross-case name collisions (including case-insensitive ones, the
soundness hole for case selection), ambiguous empty cases, positionals
inside or alongside a union, and malformed case payloads are now
asserted by driving the generator over in-memory source.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>

Author: Smaug123

WoofWare.Myriad.Plugins/Test/TestArgParserRejection.fs

@@ -255,3 +255,217 @@ type NoConflict =
 
         // One namespace for the embedded runtime module, one for the generated parser module.
         List.length modules |> shouldEqual 2
+
+    // ------------------------------------------------------------------------------------------
+    // Discriminated unions of alternative argument sets. Global name uniqueness (under the
+    // scanner's case-insensitive equality) is the axiom which makes case selection sound: an
+    // argument name shared between two cases would be routed to whichever case is declared
+    // first, silently selecting it.
+
+    [<Test>]
+    let ``Argument names differing only by case collide across union cases`` () =
+        // The empirical counterexample from review: with a case-sensitive check, `--FOO=3` parsed
+        // successfully and constructed FooCase, and BarCase's argument was unreachable.
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type FooArgs =
+    {
+        Foo : int
+    }
+
+type BarArgs =
+    {
+        [<ArgumentLongForm "FOO">]
+        Bar : int
+    }
+
+[<ArgParser>]
+type DuArgs =
+    | FooCase of FooArgs
+    | BarCase of BarArgs
+"""
+        |> shouldRejectWith
+            "Conflicting argument names detected (names are matched case-insensitively):\nThe argument name '--foo' is claimed by: '--foo' (field 'Foo'); '--FOO' (field 'Bar')"
+
+    [<Test>]
+    let ``Identical argument names collide across union cases`` () =
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type FooArgs =
+    {
+        Foo : int
+    }
+
+type BarArgs =
+    {
+        [<ArgumentLongForm "foo">]
+        Bar : int
+    }
+
+[<ArgParser>]
+type DuArgs =
+    | FooCase of FooArgs
+    | BarCase of BarArgs
+"""
+        |> shouldRejectWith
+            "Conflicting argument names detected (names are matched case-insensitively):\nThe argument name '--foo' is claimed by: '--foo' (field 'Foo'); '--foo' (field 'Bar')"
+
+    [<Test>]
+    let ``Two union cases which are both satisfiable with no arguments are rejected`` () =
+        // An empty command line could not choose between them.
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type AllOptionalA =
+    {
+        A : int option
+    }
+
+type AllOptionalB =
+    {
+        B : int option
+    }
+
+[<ArgParser>]
+type AmbiguousEmptyCases =
+    | CaseA of AllOptionalA
+    | CaseB of AllOptionalB
+"""
+        |> shouldRejectWith
+            "Cases CaseA, CaseB can all be satisfied without supplying any arguments, so an empty command line cannot choose between them. Make an argument in all but one of them mandatory."
+
+    [<Test>]
+    let ``Positional args are rejected inside a union case`` () =
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type SomePositionals =
+    {
+        [<PositionalArgs>]
+        Rest : string list
+    }
+
+type NotPositional =
+    {
+        C : int
+    }
+
+type PositionalOrNot =
+    | Pos of SomePositionals
+    | NotPos of NotPositional
+
+[<ArgParser>]
+type PositionalInsideUnion =
+    {
+        Choice : PositionalOrNot
+    }
+"""
+        |> shouldRejectWith
+            "Positional args are not permitted inside cases of the [<ArgParser>] union PositionalOrNot: the parser could not tell which alternative a positional arg belongs to."
+
+    [<Test>]
+    let ``Positional args are rejected alongside a union`` () =
+        // Conservative in v1: a Reject-mode sink beside a union is in principle sound (bare
+        // tokens cannot influence case selection), but a Collect-mode sink silently swallows
+        // typo'd case-selecting keys, so for now the combination is banned wholesale.
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type AutoMode =
+    {
+        Quiet : bool option
+    }
+
+type ManualMode =
+    {
+        Level : int
+    }
+
+type Mode =
+    | Auto of AutoMode
+    | Manual of ManualMode
+
+[<ArgParser>]
+type WithModeAndPositionals =
+    {
+        Mode : Mode
+
+        [<PositionalArgs>]
+        Rest : string list
+    }
+"""
+        |> shouldRejectWith
+            "Positional args cannot be combined with a discriminated-union arg: the parser could not tell which alternative an unrecognised arg belongs to."
+
+    [<Test>]
+    let ``A union case must carry a record defined alongside the union`` () =
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type FooArgs =
+    {
+        Foo : int
+    }
+
+[<ArgParser>]
+type BadDu =
+    | FooCase of int
+    | BarCase of FooArgs
+"""
+        |> shouldRejectWith
+            "Case FooCase of [<ArgParser>] union BadDu must have a payload which is a record defined alongside the union."
+
+    [<Test>]
+    let ``A union case must carry exactly one field`` () =
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type FooArgs =
+    {
+        Foo : int
+    }
+
+[<ArgParser>]
+type BadDu =
+    | FooCase of FooArgs * int
+    | BarCase of FooArgs
+"""
+        |> shouldRejectWith
+            "Case FooCase of [<ArgParser>] union BadDu must have exactly one field: a record holding that case's arguments."
+
+    [<Test>]
+    let ``The motivating union of alternative argument sets generates successfully`` () =
+        let modules =
+            generateFromSource
+                """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type FooArgs =
+    {
+        Foo : int
+    }
+
+type BarArgs =
+    {
+        Bar : int
+        Baz : int
+    }
+
+[<ArgParser>]
+type DuArgs =
+    | FooCase of FooArgs
+    | BarCase of BarArgs
+"""
+
+        // One namespace for the embedded runtime module, one for the generated parser module.
+        List.length modules |> shouldEqual 2