Bugfix:: Add missing codegen for mapping of overlapped struct DU fields and read it in fslib reflection

docs/release-notes/.FSharp.Compiler.Service/9.0.300.md

@@ -13,3 +13,4 @@
 * Update `Obsolete` attribute checking to account for `DiagnosticId` and `UrlFormat` properties. ([PR #18224](https://github.com/dotnet/fsharp/pull/18224))
 
 ### Breaking Changes
+* Struct unions with overlapping fields now generate mappings needed for reading via reflection ([Issue #18121](https://github.com/dotnet/fsharp/issues/17797), [PR #18274](https://github.com/dotnet/fsharp/pull/17877))

docs/release-notes/.FSharp.Core/9.0.300.md

@@ -0,0 +1,8 @@
+### Fixed
+
+### Added
+
+### Changed
+
+### Breaking Changes
+* Struct unions with overlapping fields now generate mappings needed for reading via reflection ([Issue #18121](https://github.com/dotnet/fsharp/issues/17797), [PR #18274](https://github.com/dotnet/fsharp/pull/17877)). Previous versions of FSharp.Core returned incomplete mapping between fields and cases, these older fslib versions will now report an exception.

src/Compiler/AbstractIL/ilx.fsi

@@ -162,6 +162,8 @@ val mkILFormalCloRef: ILGenericParameterDefs -> IlxClosureRef -> useStaticField:
 // MS-ILX: Unions
 // --------------------------------------------------------------------
 
+val mkLowerName: nm: string -> string
+
 val actualTypOfIlxUnionField: IlxUnionSpec -> int -> int -> ILType
 
 val mkILFreeVar: string * bool * ILType -> IlxClosureFreeVar

src/Compiler/CodeGen/IlxGen.fs

@@ -601,6 +601,29 @@ let voidCheck m g permits ty =
         error (InternalError("System.Void unexpectedly detected in IL code generation. This should not occur.", m))
 #endif
 
+[<Struct>]
+type DuFieldCoordinates = { CaseIdx: int; FieldIdx: int }
+
+/// Structure for maintaining field reuse across struct unions
+type UnionFieldReuseMap = MultiMap<string, DuFieldCoordinates>
+
+let unionFieldReuseMapping thisUnionTy (cases: UnionCase[]) : UnionFieldReuseMap =
+
+    if not (isStructTyconRef thisUnionTy) then
+        Map.empty
+    else
+        let fieldKey (f: RecdField) = mkLowerName f.LogicalName
+
+        [
+            for i = 0 to cases.Length - 1 do
+                let fields = cases[i].RecdFieldsArray
+
+                for j = 0 to fields.Length - 1 do
+                    let f = fields[j]
+                    yield fieldKey f, { CaseIdx = i; FieldIdx = j }
+        ]
+        |> MultiMap.ofList
+
 /// When generating parameter and return types generate precise .NET IL pointer types.
 /// These can't be generated for generic instantiations, since .NET generics doesn't
 /// permit this. But for 'naked' values (locals, parameters, return values etc.) machine
@@ -702,18 +725,24 @@ and GenTypeAux cenv m (tyenv: TypeReprEnv) voidOK ptrsOK ty =
 //--------------------------------------------------------------------------
 // Generate ILX references to closures, classunions etc. given a tyenv
 //--------------------------------------------------------------------------
-
-and GenUnionCaseRef (cenv: cenv) m tyenv i (fspecs: RecdField[]) =
+and GenUnionCaseRef (cenv: cenv) m tyenv (reuseMap: UnionFieldReuseMap) i (fspecs: RecdField[]) =
     let g = cenv.g
 
+    let fieldMarker = int SourceConstructFlags.Field
+
     fspecs
     |> Array.mapi (fun j fspec ->
         let ilFieldDef =
             mkILInstanceField (fspec.LogicalName, GenType cenv m tyenv fspec.FormalType, None, ILMemberAccess.Public)
         // These properties on the "field" of an alternative end up going on a property generated by cu_erase.fs
-        let attrs =
-            (mkCompilationMappingAttrWithVariantNumAndSeqNum g (int SourceConstructFlags.Field) i j)
-            :: GenAdditionalAttributesForTy g fspec.FormalType
+        let mappingAttrs =
+            match reuseMap |> MultiMap.find (mkLowerName fspec.LogicalName) with
+            | [] -> [ mkCompilationMappingAttrWithVariantNumAndSeqNum g fieldMarker i j ]
+            | mappings ->
+                mappings
+                |> List.map (fun m -> mkCompilationMappingAttrWithVariantNumAndSeqNum g fieldMarker m.CaseIdx m.FieldIdx)
+
+        let attrs = mappingAttrs @ GenAdditionalAttributesForTy g fspec.FormalType
 
         IlxUnionCaseField(ilFieldDef.With(customAttrs = mkILCustomAttrs attrs)))
 
@@ -731,13 +760,15 @@ and GenUnionRef (cenv: cenv) m (tcref: TyconRef) =
             match tcref.CompiledRepresentation with
             | CompiledTypeRepr.ILAsmOpen _ -> failwith "GenUnionRef m: unexpected ASM tyrep"
             | CompiledTypeRepr.ILAsmNamed(tref, _, _) ->
+                let fieldReuseMap = unionFieldReuseMapping tcref tycon.UnionCasesArray
+
                 let alternatives =
                     tycon.UnionCasesArray
                     |> Array.mapi (fun i cspec ->
                         {
                             altName = cspec.CompiledName
                             altCustomAttrs = emptyILCustomAttrs
-                            altFields = GenUnionCaseRef cenv m tyenvinner i cspec.RecdFieldsArray
+                            altFields = GenUnionCaseRef cenv m tyenvinner fieldReuseMap i cspec.RecdFieldsArray
                         })
 
                 let nullPermitted = IsUnionTypeWithNullAsTrueValue g tycon
@@ -11658,11 +11689,13 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
                      | _ -> false)
                     ->
                     let alternatives =
+                        let fieldReuseMap = unionFieldReuseMapping tcref tycon.UnionCasesArray
+
                         tycon.UnionCasesArray
                         |> Array.mapi (fun i ucspec ->
                             {
                                 altName = ucspec.CompiledName
-                                altFields = GenUnionCaseRef cenv m eenvinner.tyenv i ucspec.RecdFieldsArray
+                                altFields = GenUnionCaseRef cenv m eenvinner.tyenv fieldReuseMap i ucspec.RecdFieldsArray
                                 altCustomAttrs =
                                     mkILCustomAttrs (
                                         GenAttrs cenv eenv ucspec.Attribs

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -8337,9 +8337,6 @@ let IsMatchingSignatureDataVersionAttr (version: ILVersionInfo) cattr =
         warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInterfaceDataVersionAttribute()))
         false
 
-let mkCompilerGeneratedAttr (g: TcGlobals) n = 
-    mkILCustomAttribute (tref_CompilationMappingAttr g, [mkILNonGenericValueTy (tref_SourceConstructFlags g)], [ILAttribElem.Int32 n], [])
-
 //--------------------------------------------------------------------------
 // tupled lambda --> method/function with a given valReprInfo specification.
 //

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -2380,8 +2380,6 @@ val mkCompilationSourceNameAttr: TcGlobals -> string -> ILAttribute
 
 val mkSignatureDataVersionAttr: TcGlobals -> ILVersionInfo -> ILAttribute
 
-val mkCompilerGeneratedAttr: TcGlobals -> int -> ILAttribute
-
 //-------------------------------------------------------------------------
 // More common type construction
 //-------------------------------------------------------------------------

src/Compiler/Utilities/illib.fs

@@ -1307,6 +1307,14 @@ module MultiMap =
     let initBy f xs : MultiMap<_, _> =
         xs |> Seq.groupBy f |> Seq.map (fun (k, v) -> (k, List.ofSeq v)) |> Map.ofSeq
 
+    let ofList (xs: ('a * 'b) list) : MultiMap<'a,'b> =
+        (Map.empty, xs)
+        ||> List.fold (fun m (k, v) ->
+            m |> Map.change k (function
+                | None -> Some [v]
+                | Some vs -> Some (v :: vs)))
+        |> Map.map (fun _ values -> List.rev values)
+
 type LayeredMap<'Key, 'Value when 'Key: comparison> = Map<'Key, 'Value>
 
 [<AutoOpen>]

src/Compiler/Utilities/illib.fsi

@@ -570,6 +570,8 @@ module internal MultiMap =
 
     val initBy: f: ('a -> 'b) -> xs: seq<'a> -> MultiMap<'b, 'a> when 'b: comparison
 
+    val ofList: xs: ('a * 'b) list -> MultiMap<'a,'b> when 'a: comparison
+
 type internal LayeredMap<'Key, 'Value when 'Key: comparison> = Map<'Key, 'Value>
 
 [<AutoOpen>]

src/FSharp.Core/prim-types.fs

@@ -221,7 +221,7 @@ namespace Microsoft.FSharp.Core
         member _.Minor = minor
         member _.Release = release
 
-    [<AttributeUsage(AttributeTargets.All, AllowMultiple=false)>]
+    [<AttributeUsage(AttributeTargets.All, AllowMultiple=true)>]
     [<Sealed>]
     type CompilationMappingAttribute(sourceConstructFlags:SourceConstructFlags,
                                      variantNumber:int,

src/FSharp.Core/prim-types.fsi

@@ -657,7 +657,7 @@ namespace Microsoft.FSharp.Core
     /// their original forms. It is not intended for use from user code.</remarks>
     ///
     /// <category>Attributes</category>
-    [<AttributeUsage (AttributeTargets.All,AllowMultiple=false)>]  
+    [<AttributeUsage (AttributeTargets.All,AllowMultiple=true)>]  
     [<Sealed>]
     type CompilationMappingAttribute =
         inherit Attribute

src/FSharp.Core/reflect.fs

@@ -266,108 +266,103 @@ module internal Impl =
     //-----------------------------------------------------------------
     // ATTRIBUTE DECOMPILATION
 
-    let tryFindCompilationMappingAttribute (attrs: obj array) =
+    let findCompilationMappingAttributeAllowMultiple (attrs: obj array) =
         match attrs with
-        | null
-        | [||] -> None
-        | [| res |] ->
-            let a = (res :?> CompilationMappingAttribute)
-            Some(a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber)
-        | _ -> invalidOp (SR.GetString(SR.multipleCompilationMappings))
-
-    let findCompilationMappingAttribute (attrs: obj array) =
-        match tryFindCompilationMappingAttribute attrs with
-        | None -> failwith "no compilation mapping attribute"
-        | Some a -> a
+        | null -> [||]
+        | attrs ->
+            attrs
+            |> Array.map (fun res ->
+                let a = (res :?> CompilationMappingAttribute)
+                (a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber))
 
     let cmaName = typeof<CompilationMappingAttribute>.FullName
     let assemblyName = typeof<CompilationMappingAttribute>.Assembly.GetName().Name
     let _ = assert (assemblyName = "FSharp.Core")
 
-    let tryFindCompilationMappingAttributeFromData (attrs: IList<CustomAttributeData>) =
+    let findCompilationMappingAttributeFromDataAllowMultiple (attrs: IList<CustomAttributeData>) =
         match attrs with
-        | null -> None
+        | null -> [||]
         | _ ->
-            let mutable res = None
-
-            for a in attrs do
-                if a.Constructor.DeclaringType.FullName = cmaName then
-                    let args = a.ConstructorArguments
-
-                    let flags =
-                        match args.Count with
-                        | 1 ->
-                            let arg0 = args.[0]
-                            let v0 = arg0.Value :?> SourceConstructFlags
-                            (v0, 0, 0)
-                        | 2 ->
-                            let arg0 = args.[0]
-                            let v0 = arg0.Value :?> SourceConstructFlags
-                            let arg1 = args.[1]
-                            let v1 = arg1.Value :?> int
-                            (v0, v1, 0)
-                        | 3 ->
-                            let arg0 = args.[0]
-                            let v0 = arg0.Value :?> SourceConstructFlags
-                            let arg1 = args.[1]
-                            let v1 = arg1.Value :?> int
-                            let arg2 = args.[2]
-                            let v2 = arg2.Value :?> int
-                            (v0, v1, v2)
-                        | _ -> (enum 0, 0, 0)
-
-                    res <- Some flags
-
-            res
-
-    let findCompilationMappingAttributeFromData attrs =
-        match tryFindCompilationMappingAttributeFromData attrs with
-        | None -> failwith "no compilation mapping attribute"
-        | Some a -> a
+            let filtered =
+                attrs
+                |> Array.ofSeq
+                |> Array.filter (fun a -> a.Constructor.DeclaringType.FullName = cmaName)
+
+            filtered
+            |> Array.map (fun a ->
+                let args = a.ConstructorArguments
+
+                match args.Count with
+                | 1 ->
+                    let arg0 = args.[0]
+                    let v0 = arg0.Value :?> SourceConstructFlags
+                    (v0, 0, 0)
+                | 2 ->
+                    let arg0 = args.[0]
+                    let v0 = arg0.Value :?> SourceConstructFlags
+                    let arg1 = args.[1]
+                    let v1 = arg1.Value :?> int
+                    (v0, v1, 0)
+                | 3 ->
+                    let arg0 = args.[0]
+                    let v0 = arg0.Value :?> SourceConstructFlags
+                    let arg1 = args.[1]
+                    let v1 = arg1.Value :?> int
+                    let arg2 = args.[2]
+                    let v2 = arg2.Value :?> int
+                    (v0, v1, v2)
+                | _ -> (enum 0, 0, 0))
 
     let tryFindCompilationMappingAttributeFromType (typ: Type) =
         let assem = typ.Assembly
 
         if (not (isNull assem)) && assem.ReflectionOnly then
-            tryFindCompilationMappingAttributeFromData (typ.GetCustomAttributesData())
-        else
-            tryFindCompilationMappingAttribute (typ.GetCustomAttributes(typeof<CompilationMappingAttribute>, false))
-
-    let tryFindCompilationMappingAttributeFromMemberInfo (info: MemberInfo) =
-        let assem = info.DeclaringType.Assembly
-
-        if (not (isNull assem)) && assem.ReflectionOnly then
-            tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData())
+            findCompilationMappingAttributeFromDataAllowMultiple (typ.GetCustomAttributesData())
         else
-            tryFindCompilationMappingAttribute (info.GetCustomAttributes(typeof<CompilationMappingAttribute>, false))
+            findCompilationMappingAttributeAllowMultiple (
+                typ.GetCustomAttributes(typeof<CompilationMappingAttribute>, false)
+            )
 
     let findCompilationMappingAttributeFromMemberInfo (info: MemberInfo) =
         let assem = info.DeclaringType.Assembly
 
         if (not (isNull assem)) && assem.ReflectionOnly then
-            findCompilationMappingAttributeFromData (info.GetCustomAttributesData())
+            findCompilationMappingAttributeFromDataAllowMultiple (info.GetCustomAttributesData())
         else
-            findCompilationMappingAttribute (info.GetCustomAttributes(typeof<CompilationMappingAttribute>, false))
+            findCompilationMappingAttributeAllowMultiple (
+                info.GetCustomAttributes(typeof<CompilationMappingAttribute>, false)
+            )
 
     let sequenceNumberOfMember (x: MemberInfo) =
-        let (_, n, _) = findCompilationMappingAttributeFromMemberInfo x in n
+        let (_, n, _) = findCompilationMappingAttributeFromMemberInfo x |> Array.head
+        n
+
+    let sequenceNumberOfUnionCaseField (x: MemberInfo) caseTag =
+        findCompilationMappingAttributeFromMemberInfo x
+        |> Array.tryFind (fun (_, _, vn) -> vn = caseTag)
+        |> Option.map (fun (_, sn, _) -> sn)
+        |> Option.defaultValue Int32.MaxValue
 
-    let variantNumberOfMember (x: MemberInfo) =
-        let (_, _, vn) = findCompilationMappingAttributeFromMemberInfo x in vn
+    let belongsToCase (x: MemberInfo) caseTag =
+        findCompilationMappingAttributeFromMemberInfo x
+        |> Array.exists (fun (_, _, vn) -> vn = caseTag)
 
     let sortFreshArray f arr =
         Array.sortInPlaceWith f arr
         arr
 
     let isFieldProperty (prop: PropertyInfo) =
-        match tryFindCompilationMappingAttributeFromMemberInfo prop with
-        | None -> false
-        | Some(flags, _n, _vn) -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Field
+        match findCompilationMappingAttributeFromMemberInfo prop with
+        | [||] -> false
+        | arr ->
+            let (flags, _, _) = arr |> Array.head
+            (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Field
 
     let tryFindSourceConstructFlagsOfType (typ: Type) =
         match tryFindCompilationMappingAttributeFromType typ with
-        | None -> None
-        | Some(flags, _n, _vn) -> Some flags
+        | [||] -> None
+        | [| flags, _n, _vn |] -> Some flags
+        | _ -> invalidOp (SR.GetString(SR.multipleCompilationMappings))
 
     //-----------------------------------------------------------------
     // UNION DECOMPILATION
@@ -379,9 +374,11 @@ module internal Impl =
         | null ->
             typ.GetMethods(staticMethodFlags ||| bindingFlags)
             |> Array.choose (fun minfo ->
-                match tryFindCompilationMappingAttributeFromMemberInfo minfo with
-                | None -> None
-                | Some(flags, n, _vn) ->
+                match findCompilationMappingAttributeFromMemberInfo minfo with
+                | [||] -> None
+                | arr ->
+                    let (flags, n, _) = arr |> Array.head
+
                     if (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.UnionCase then
                         let nm = minfo.Name
                         // chop "get_" or  "New" off the front
@@ -510,8 +507,9 @@ module internal Impl =
 
             caseTyp.GetProperties(instancePropertyFlags ||| bindingFlags)
             |> Array.filter isFieldProperty
-            |> Array.filter (fun prop -> variantNumberOfMember prop = tag)
-            |> sortFreshArray (fun p1 p2 -> compare (sequenceNumberOfMember p1) (sequenceNumberOfMember p2))
+            |> Array.filter (fun prop -> belongsToCase prop tag)
+            |> sortFreshArray (fun p1 p2 ->
+                compare (sequenceNumberOfUnionCaseField p1 tag) (sequenceNumberOfUnionCaseField p2 tag))
 
     let getUnionCaseRecordReader (typ: Type, tag: int, bindingFlags) =
         let props = fieldsPropsOfUnionCase (typ, tag, bindingFlags)