Reject recursive argument schemas instead of overflowing the stack

toParseSpec and unionToParseSpec descend into ambient records and
unions by name with no memory of what they were already expanding, so a
schema which refers to itself (even indirectly, e.g. a union whose case
payload record holds a field of that union) recursed until the Myriad
subprocess died with a stack overflow. Thread the chain of types
currently being lowered through the recursion and fail with the cycle
path on re-entry.

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

Author: Smaug123

WoofWare.Myriad.Plugins/ArgParserGenerator.fs

@@ -811,14 +811,31 @@ module internal ArgParserGenerator =
 
                 parser, Accumulation.Required, ty
 
+    /// An argument schema must be a finite tree: a record or union which refers to itself, even
+    /// indirectly, would expand forever. `ancestors` is the chain of type names currently being
+    /// lowered, innermost first; re-entry into any of them is a cycle, which we reject rather
+    /// than dying with a stack overflow. (Names are the bare idText, matching the by-name lookup
+    /// which resolves ambient type references.)
+    let private pushSchemaType (ancestors : string list) (name : Ident) : string list =
+        if ancestors |> List.contains name.idText then
+            let path = name.idText :: ancestors |> List.rev |> String.concat " -> "
+
+            failwith
+                $"The [<ArgParser>] schema is recursive: %s{path}. Argument records and unions may not contain themselves, even indirectly."
+
+        name.idText :: ancestors
+
     let rec private toParseSpec
+        (ancestors : string list)
         (counter : int)
         (flagDus : FlagDu list)
         (ambientUnions : UnionType list)
         (ambientRecords : RecordType list)
         (finalRecord : RecordType)
         : ParseTreeCrate * int
         =
+        let ancestors = pushSchemaType ancestors finalRecord.Name
+
         finalRecord.Fields
         |> List.iter (fun (SynField.SynField (isStatic = isStatic)) ->
             if isStatic then
@@ -911,7 +928,8 @@ module internal ArgParserGenerator =
                 match ambientRecordMatch with
                 | Some ambient ->
                     // This field has a type we need to obtain from parsing another record.
-                    let spec, counter = toParseSpec counter flagDus ambientUnions ambientRecords ambient
+                    let spec, counter =
+                        toParseSpec ancestors counter flagDus ambientUnions ambientRecords ambient
 
                     counter, (ident, spec) :: acc
                 | None ->
@@ -921,7 +939,7 @@ module internal ArgParserGenerator =
                     // A discriminated union of alternative argument sets: exactly one case's
                     // arguments must be supplied.
                     let spec, counter =
-                        unionToParseSpec counter flagDus ambientUnions ambientRecords union
+                        unionToParseSpec ancestors counter flagDus ambientUnions ambientRecords union
 
                     counter, (ident, spec) :: acc
                 | None ->
@@ -1051,13 +1069,16 @@ module internal ArgParserGenerator =
     /// is a record defined alongside it, into a Sum parse-tree node: exactly one case's
     /// arguments must be supplied at runtime.
     and private unionToParseSpec
+        (ancestors : string list)
         (counter : int)
         (flagDus : FlagDu list)
         (ambientUnions : UnionType list)
         (ambientRecords : RecordType list)
         (union : UnionType)
         : ParseTreeCrate * int
         =
+        let ancestors = pushSchemaType ancestors union.Name
+
         let sumId = counter
         let counter = counter + 1
 
@@ -1084,7 +1105,7 @@ module internal ArgParserGenerator =
                             $"Case %s{case.Name.idText} of [<ArgParser>] union %s{union.Name.idText} must have exactly one field: a record holding that case's arguments."
 
                 let spec, counter =
-                    toParseSpec counter flagDus ambientUnions ambientRecords payloadRecord
+                    toParseSpec ancestors counter flagDus ambientUnions ambientRecords payloadRecord
 
                 let tree =
                     ParseTree.assertNoPositional
@@ -1997,7 +2018,7 @@ module internal ArgParserGenerator =
                                        _) ->
                 let record = RecordType.OfRecord sci smd access fields
 
-                let spec, _ = toParseSpec 0 flagDus structuralUnions allRecordTypes record
+                let spec, _ = toParseSpec [] 0 flagDus structuralUnions allRecordTypes record
 
                 record.Name, typeHelp attrs, spec
             | SynTypeDefn.SynTypeDefn (SynComponentInfo.SynComponentInfo (attributes = attrs) as sci,
@@ -2008,7 +2029,7 @@ module internal ArgParserGenerator =
                                        _) ->
                 let union = UnionType.OfUnion sci smd access cases
 
-                let spec, _ = unionToParseSpec 0 flagDus structuralUnions allRecordTypes union
+                let spec, _ = unionToParseSpec [] 0 flagDus structuralUnions allRecordTypes union
 
                 union.Name, typeHelp attrs, spec
             | _ ->

WoofWare.Myriad.Plugins/Test/TestArgParserRejection.fs

@@ -620,6 +620,96 @@ type ParentRecord =
 
         List.length modules |> shouldEqual 2
 
+    // ------------------------------------------------------------------------------------------
+    // Recursive schemas. An argument schema must be a finite tree: a record or union which
+    // refers to itself, even indirectly, would expand forever. Without an explicit check the
+    // generator recurses until the process dies with a stack overflow instead of producing a
+    // comprehensible error.
+
+    [<Test>]
+    let ``A record which contains itself is rejected`` () =
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+[<ArgParser>]
+type SelfRef =
+    {
+        Value : int
+        Nested : SelfRef
+    }
+"""
+        |> shouldRejectWith
+            "The [<ArgParser>] schema is recursive: SelfRef -> SelfRef. Argument records and unions may not contain themselves, even indirectly."
+
+    [<Test>]
+    let ``Mutually recursive records are rejected`` () =
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type Inner =
+    {
+        A : int
+        Outer : OuterRef
+    }
+
+[<ArgParser>]
+type OuterRef =
+    {
+        B : int
+        Inner : Inner
+    }
+"""
+        |> shouldRejectWith
+            "The [<ArgParser>] schema is recursive: OuterRef -> Inner -> OuterRef. Argument records and unions may not contain themselves, even indirectly."
+
+    [<Test>]
+    let ``A union whose case payload contains the union itself is rejected`` () =
+        // The review counterexample: descending into the payload record re-enters the union,
+        // and the Myriad subprocess used to die with a stack overflow (exit 134).
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type LoopArgs =
+    {
+        Foo : int
+        Again : LoopDu
+    }
+
+[<ArgParser>]
+type LoopDu =
+    | Loop of LoopArgs
+"""
+        |> shouldRejectWith
+            "The [<ArgParser>] schema is recursive: LoopDu -> LoopArgs -> LoopDu. Argument records and unions may not contain themselves, even indirectly."
+
+    [<Test>]
+    let ``A cycle which does not pass through the tagged type is rejected`` () =
+        """namespace TestMe
+
+open WoofWare.Myriad.Plugins
+
+type ModePayload =
+    {
+        Level : int
+        Fallback : Mode
+    }
+
+type Mode =
+    | Auto of ModePayload
+
+[<ArgParser>]
+type TopArgs =
+    {
+        Verbose : bool
+        Mode : Mode
+    }
+"""
+        |> shouldRejectWith
+            "The [<ArgParser>] schema is recursive: TopArgs -> Mode -> ModePayload -> Mode. Argument records and unions may not contain themselves, even indirectly."
+
     [<Test>]
     let ``The motivating union of alternative argument sets generates successfully`` () =
         let modules =