Scope generated opens to the tagged type's namespace block

Every generator previously emitted every `open` from the whole input file
into every generated namespace (via Whippet's AstHelper.extractOpens,
which shadows the identically-named dead local helper). A relative open
that is valid in one namespace block is not necessarily valid in another,
so generated code for a type in a different block could fail to compile.

extractOpensForNamespace collects opens only from the namespace blocks
sharing the tagged type's name (same-named blocks share a resolution
context, so unioning those is sound). The dead local extractOpens is
replaced. ConsumePlugin/OpensLeakRegression.fs is a compile-time
regression test: its bait block contains a relative `open Sub` which
does not resolve in the victim namespace, so the pre-fix generator
produces uncompilable output for it (verified against the pre-fix
plugin).

No checked-in generated code changes: no existing input relied on the leak.

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

Author: Smaug123

ConsumePlugin/ConsumePlugin.fsproj

@@ -100,6 +100,10 @@
     <Compile Include="GeneratedArgParserNegationTests.fs">
       <MyriadFile>ArgParserNegationTests.fs</MyriadFile>
     </Compile>
+    <Compile Include="OpensLeakRegression.fs" />
+    <Compile Include="GeneratedOpensLeakRegression.fs">
+      <MyriadFile>OpensLeakRegression.fs</MyriadFile>
+    </Compile>
     <!-- Not compiled, because by design they *don't* compile. That makes them very hard to test in an automated way! -->
     <None Include="ArgParserConflictTests.fs" />
     <!-- To run the conflict tests:

ConsumePlugin/GeneratedOpensLeakRegression.fs

@@ -0,0 +1,156 @@
+//------------------------------------------------------------------------------
+//        This code was generated by myriad.
+//        Changes to this file will be lost when the code is regenerated.
+//------------------------------------------------------------------------------
+
+
+
+
+
+
+
+namespace ConsumePlugin.OpensLeakVictim
+
+open WoofWare.Myriad.Plugins
+
+/// Methods to parse arguments for the type LeakArgs
+[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module LeakArgs =
+    type private ParseState_LeakArgs =
+        /// Ready to consume a key or positional arg
+        | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
+        | AwaitingValue of key : string
+
+    let parse' (getEnvironmentVariable : string -> string option) (args : string list) : LeakArgs =
+        let ArgParser_errors = ResizeArray ()
+
+        let helpText () =
+            [ (sprintf "%s  int32%s%s" (sprintf "--%s" "foo") "" "") ] |> String.concat "\n"
+
+        let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
+        let mutable arg_0 : int option = None
+
+        /// Processes the key-value pair, returning Error if no key was matched.
+        /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
+        /// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
+        let processKeyValue (key : string) (value : string) : Result<unit, string option> =
+            if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then
+                match arg_0 with
+                | Some x ->
+                    sprintf
+                        "Argument '%s' was supplied multiple times: %s and %s"
+                        (sprintf "--%s" "foo")
+                        (x.ToString ())
+                        (value.ToString ())
+                    |> ArgParser_errors.Add
+
+                    Ok ()
+                | None ->
+                    try
+                        arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some
+                        Ok ()
+                    with _ as exc ->
+                        exc.Message |> Some |> Error
+            else
+                Error None
+
+        /// Returns false if we didn't set a value.
+        let setFlagValue (key : string) : bool = false
+
+        let rec go (state : ParseState_LeakArgs) (args : string list) =
+            match args with
+            | [] ->
+                match state with
+                | ParseState_LeakArgs.AwaitingKey -> ()
+                | ParseState_LeakArgs.AwaitingValue key ->
+                    if setFlagValue key then
+                        ()
+                    else
+                        sprintf
+                            "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
+                            key
+                        |> ArgParser_errors.Add
+            | "--" :: rest ->
+                match state with
+                | ParseState_LeakArgs.AwaitingKey -> ()
+                | ParseState_LeakArgs.AwaitingValue key ->
+                    if setFlagValue key then
+                        ()
+                    else
+                        sprintf
+                            "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
+                            key
+                        |> ArgParser_errors.Add
+
+                parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
+            | arg :: args ->
+                match state with
+                | ParseState_LeakArgs.AwaitingKey ->
+                    if arg.StartsWith ("--", System.StringComparison.Ordinal) then
+                        if arg = "--help" then
+                            helpText () |> failwithf "Help text requested.\n%s"
+                        else
+                            let equals = arg.IndexOf (char 61)
+
+                            if equals < 0 then
+                                args |> go (ParseState_LeakArgs.AwaitingValue arg)
+                            else
+                                let key = arg.[0 .. equals - 1]
+                                let value = arg.[equals + 1 ..]
+
+                                match processKeyValue key value with
+                                | Ok () -> go ParseState_LeakArgs.AwaitingKey args
+                                | Error x ->
+                                    match x with
+                                    | None ->
+                                        failwithf "Unable to process argument %s as key %s and value %s" arg key value
+                                    | Some msg ->
+                                        sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
+                                        go ParseState_LeakArgs.AwaitingKey args
+                    else
+                        arg |> (fun x -> x) |> parser_LeftoverArgs.Add
+                        go ParseState_LeakArgs.AwaitingKey args
+                | ParseState_LeakArgs.AwaitingValue key ->
+                    match processKeyValue key arg with
+                    | Ok () -> go ParseState_LeakArgs.AwaitingKey args
+                    | Error exc ->
+                        if setFlagValue key then
+                            go ParseState_LeakArgs.AwaitingKey (arg :: args)
+                        else
+                            match exc with
+                            | None ->
+                                failwithf "Unable to process supplied arg %s. Help text follows.\n%s" key (helpText ())
+                            | Some msg -> msg |> ArgParser_errors.Add
+
+        go ParseState_LeakArgs.AwaitingKey args
+
+        let parser_LeftoverArgs =
+            if 0 = parser_LeftoverArgs.Count then
+                ()
+            else
+                parser_LeftoverArgs
+                |> String.concat " "
+                |> sprintf "There were leftover args: %s"
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+
+        let arg_0 =
+            match arg_0 with
+            | None ->
+                sprintf "Required argument '%s' received no value" (sprintf "--%s" "foo")
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+            | Some x -> x
+
+        if 0 = ArgParser_errors.Count then
+            {
+                Foo = arg_0
+            }
+        else
+            ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
+
+    let parse (args : string list) : LeakArgs =
+        parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args

ConsumePlugin/OpensLeakRegression.fs

@@ -0,0 +1,29 @@
+// Regression test for the opens leak: `open` declarations from one namespace block of an input
+// file must not appear in generated code for a *different* namespace block. The bait below is a
+// relative `open Sub`, which resolves only from within ConsumePlugin.OpensLeak; if it leaked into
+// the generated module for ConsumePlugin.OpensLeakVictim, this project would fail to compile.
+namespace ConsumePlugin.OpensLeak.Sub
+
+module internal RelativeOpenBait =
+    let internal bait : int = 1
+
+namespace ConsumePlugin.OpensLeak
+
+open Sub
+
+type UsesTheBait =
+    {
+        Ignored : int
+    }
+
+    static member internal Use () : int = RelativeOpenBait.bait
+
+namespace ConsumePlugin.OpensLeakVictim
+
+open WoofWare.Myriad.Plugins
+
+[<ArgParser>]
+type LeakArgs =
+    {
+        Foo : int
+    }

WoofWare.Myriad.Plugins/ArgParserGenerator.fs

@@ -2148,6 +2148,7 @@ type ArgParserGenerator () =
             let modules =
                 namespaceAndTypes
                 |> List.map (fun (ns, taggedType, unions, records) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
                     ArgParserGenerator.createModule opens ns taggedType unions records
                 )
 

WoofWare.Myriad.Plugins/AstHelper.fs

@@ -57,11 +57,27 @@ module internal AstHelper =
             | _ -> None
         )
 
-    let extractOpens (ast : ParsedInput) : SynOpenDeclTarget list =
+    /// Extract the `open` declarations from those top-level namespace/module blocks of the file
+    /// whose name is `ns`. Opens from differently-named blocks must not leak into generated code
+    /// for this namespace: a relative `open` which is valid in one namespace block can be invalid
+    /// (or resolve to something else) in another. Two blocks with the same name share a resolution
+    /// context, so it is sound to union their opens.
+    ///
+    /// (Note: this deliberately does not share a name with WoofWare.Whippet.Fantomas's
+    /// `AstHelper.extractOpens`, which shadows this module's members at generator call sites and
+    /// extracts opens from *every* block in the file.)
+    let extractOpensForNamespace (ns : LongIdent) (ast : ParsedInput) : SynOpenDeclTarget list =
+        let nsName = ns |> List.map _.idText
+
         match ast with
         | ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, _, modules, _, _, _)) ->
             modules
-            |> List.collect (fun (SynModuleOrNamespace (_, _, _, decls, _, _, _, _, _)) -> extractOpensFromDecl decls)
+            |> List.collect (fun (SynModuleOrNamespace (longId, _, _, decls, _, _, _, _, _)) ->
+                if (longId |> List.map _.idText) = nsName then
+                    extractOpensFromDecl decls
+                else
+                    []
+            )
         | _ -> []
 
     let rec convertSigParam (ty : SynType) : ParameterInfo * bool =

WoofWare.Myriad.Plugins/CapturingInterfaceMockGenerator.fs

@@ -735,11 +735,10 @@ type CapturingInterfaceMockGenerator () =
                         | ty -> Some (ns, ty)
                 )
 
-            let opens = AstHelper.extractOpens ast
-
             let modules =
                 namespaceAndInterfaces
                 |> List.collect (fun (ns, records) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
                     records |> List.map (CapturingInterfaceMockGenerator.createRecord ns opens)
                 )
 

WoofWare.Myriad.Plugins/CataGenerator.fs

@@ -1266,6 +1266,7 @@ type CreateCatamorphismGenerator () =
             let modules =
                 namespaceAndTypes
                 |> List.map (fun (ns, taggedType, unions, records) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
                     CataGenerator.createModule opens ns taggedType unions records
                 )
 

WoofWare.Myriad.Plugins/HttpClientGenerator.fs

@@ -1294,6 +1294,9 @@ type HttpClientGenerator () =
 
             let modules =
                 namespaceAndTypes
-                |> List.collect (fun (ns, types) -> types |> List.map (HttpClientGenerator.createModule opens ns))
+                |> List.collect (fun (ns, types) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
+                    types |> List.map (HttpClientGenerator.createModule opens ns)
+                )
 
             Output.Ast modules

WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs

@@ -418,11 +418,10 @@ type InterfaceMockGenerator () =
                         | ty -> Some (ns, ty)
                 )
 
-            let opens = AstHelper.extractOpens ast
-
             let modules =
                 namespaceAndInterfaces
                 |> List.collect (fun (ns, records) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
                     records |> List.map (InterfaceMockGenerator.createRecord ns opens)
                 )
 

WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs

@@ -824,11 +824,11 @@ type JsonSerializeGenerator () =
                         | ty -> Some (ns, ty)
                 )
 
-            let opens = AstHelper.extractOpens ast
-
             let modules =
                 namespaceAndTypes
                 |> List.collect (fun (ns, types) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
+
                     types
                     |> List.map (fun (ty, spec) -> JsonSerializeGenerator.createModule ns opens spec ty)
                 )