Nullness :: Bugfix :: Codegen missing metadata for C# consumers (reco…

…rds,DUs,exceptions) (dotnet#18079)
psfinaki · Dec 6, 2024 · a90f6d1 · a90f6d1
1 parent b204b96
commit a90f6d1
Show file tree

Hide file tree

Showing 153 changed files with 3,962 additions and 4,740 deletions.
diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md
@@ -14,6 +14,7 @@
 * Fix failure to use bound values in `when` clauses of `try-with` in `seq` expressions ([PR #17990](https://github.com/dotnet/fsharp/pull/17990))
 * Fix locals allocating for the special `copyOfStruct` defensive copy ([PR #18025](https://github.com/dotnet/fsharp/pull/18025))
 * Fix lowering of computed array expressions when the expression consists of a simple mapping from a `uint64` or `unativeint` array. [PR #18081](https://github.com/dotnet/fsharp/pull/18081)
+* Add missing nullable-metadata for C# consumers of records,exceptions and DU subtypes generated from F# code. [PR #18079](https://github.com/dotnet/fsharp/pull/18079)
 
 
 ### Added

diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs
@@ -4208,14 +4208,25 @@ let mkILStorageCtorWithParamNames (preblock: ILInstr list, ty, extraParams, flds
             | Some x -> I_seqpoint x
             | None -> ()
             yield! preblock
-            for (n, (_pnm, nm, fieldTy)) in List.indexed flds do
+            for (n, (_pnm, nm, fieldTy,_attrs)) in List.indexed flds do
                 mkLdarg0
                 mkLdarg (uint16 (n + 1))
                 mkNormalStfld (mkILFieldSpecInTy (ty, nm, fieldTy))
         ]
 
     let body = mkMethodBody (false, [], 2, nonBranchingInstrsToCode code, tag, imports)
-    mkILCtor (access, (flds |> List.map (fun (pnm, _, ty) -> mkILParamNamed (pnm, ty))) @ extraParams, body)
+    let fieldParams = 
+        [
+            for (pnm,_,ty,attrs) in flds do
+                let ilParam = mkILParamNamed (pnm, ty)
+                let ilParam =
+                    match attrs with
+                    | [] -> ilParam
+                    | attrs -> {ilParam with CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs attrs ) }
+                yield ilParam
+        ]    
+
+    mkILCtor (access, fieldParams @ extraParams , body)
 
 let mkILSimpleStorageCtorWithParamNames (baseTySpec, ty, extraParams, flds, access, tag, imports) =
     let preblock =
@@ -4226,7 +4237,7 @@ let mkILSimpleStorageCtorWithParamNames (baseTySpec, ty, extraParams, flds, acce
     mkILStorageCtorWithParamNames (preblock, ty, extraParams, flds, access, tag, imports)
 
 let addParamNames flds =
-    flds |> List.map (fun (nm, ty) -> (nm, nm, ty))
+    flds |> List.map (fun (nm, ty, attrs) -> (nm, nm, ty, attrs))
 
 let mkILSimpleStorageCtor (baseTySpec, ty, extraParams, flds, access, tag, imports) =
     mkILSimpleStorageCtorWithParamNames (baseTySpec, ty, extraParams, addParamNames flds, access, tag, imports)

diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi
@@ -2217,14 +2217,19 @@ val internal prependInstrsToClassCtor:
 
 /// Derived functions for making some simple constructors
 val internal mkILStorageCtor:
-    ILInstr list * ILType * (string * ILType) list * ILMemberAccess * ILDebugPoint option * ILDebugImports option ->
+    ILInstr list *
+    ILType *
+    (string * ILType * ILAttribute list) list *
+    ILMemberAccess *
+    ILDebugPoint option *
+    ILDebugImports option ->
         ILMethodDef
 
 val internal mkILSimpleStorageCtor:
     ILTypeSpec option *
     ILType *
     ILParameter list *
-    (string * ILType) list *
+    (string * ILType * ILAttribute list) list *
     ILMemberAccess *
     ILDebugPoint option *
     ILDebugImports option ->
@@ -2234,7 +2239,7 @@ val internal mkILSimpleStorageCtorWithParamNames:
     ILTypeSpec option *
     ILType *
     ILParameter list *
-    (string * string * ILType) list *
+    (string * string * ILType * ILAttribute list) list *
     ILMemberAccess *
     ILDebugPoint option *
     ILDebugImports option ->

diff --git a/src/Compiler/CodeGen/EraseClosures.fs b/src/Compiler/CodeGen/EraseClosures.fs
@@ -560,7 +560,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
                     mkILStorageCtor (
                         [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (cenv.mkILTyFuncTy, [])) ],
                         nowTy,
-                        mkILCloFldSpecs cenv nowFields,
+                        mkILCloFldSpecs cenv nowFields |> List.map (fun (name, t) -> (name, t, [])),
                         ILMemberAccess.Assembly,
                         None,
                         None
@@ -695,7 +695,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
                         mkILStorageCtor (
                             [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (nowEnvParentClass, [])) ],
                             nowTy,
-                            mkILCloFldSpecs cenv nowFields,
+                            mkILCloFldSpecs cenv nowFields |> List.map (fun (name, t) -> (name, t, [])),
                             ILMemberAccess.Assembly,
                             None,
                             cloImports

diff --git a/src/Compiler/CodeGen/EraseUnions.fs b/src/Compiler/CodeGen/EraseUnions.fs
@@ -214,6 +214,18 @@ let mkUnionCaseFieldId (fdef: IlxUnionCaseField) =
     // Use the lower case name of a field or constructor as the field/parameter name if it differs from the uppercase name
     fdef.LowerName, fdef.Type
 
+let inline getFieldsNullability (g: TcGlobals) (ilf: ILFieldDef) =
+    if g.checkNullness then
+        ilf.CustomAttrs.AsArray()
+        |> Array.tryFind (IsILAttrib g.attrib_NullableAttribute)
+    else
+        None
+
+let mkUnionCaseFieldIdAndAttrs g fdef =
+    let nm, t = mkUnionCaseFieldId fdef
+    let attrs = getFieldsNullability g fdef.ILField
+    nm, t, attrs |> Option.toList
+
 let refToFieldInTy ty (nm, fldTy) = mkILFieldSpecInTy (ty, nm, fldTy)
 
 let formalTypeArgs (baseTy: ILType) =
@@ -711,14 +723,9 @@ let mkMethodsAndPropertiesForFields
                 let ilReturn = mkILReturn field.Type
 
                 let ilReturn =
-                    if TryFindILAttribute g.attrib_NullableAttribute field.ILField.CustomAttrs then
-                        let attrs =
-                            field.ILField.CustomAttrs.AsArray()
-                            |> Array.filter (IsILAttrib g.attrib_NullableAttribute)
-
-                        ilReturn.WithCustomAttrs(mkILCustomAttrsFromArray attrs)
-                    else
-                        ilReturn
+                    match getFieldsNullability g field.ILField with
+                    | None -> ilReturn
+                    | Some a -> ilReturn.WithCustomAttrs(mkILCustomAttrsFromArray [| a |])
 
                 yield
                     mkILNonGenericInstanceMethod (
@@ -808,22 +815,19 @@ let convAlternativeDef
                 |> Array.map (fun fd ->
                     let plainParam = mkILParamNamed (fd.LowerName, fd.Type)
 
-                    if TryFindILAttribute g.attrib_NullableAttribute fd.ILField.CustomAttrs then
-                        let attrs =
-                            fd.ILField.CustomAttrs.AsArray()
-                            |> Array.filter (IsILAttrib g.attrib_NullableAttribute)
-
+                    match getFieldsNullability g fd.ILField with
+                    | None -> plainParam
+                    | Some a ->
                         { plainParam with
-                            CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrsFromArray attrs)
-                        }
-                    else
-                        plainParam)
+                            CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrsFromArray [| a |])
+                        })
+
                 |> Array.toList,
                 mkILReturn baseTy,
                 mkMethodBody (true, locals, fields.Length + locals.Length, nonBranchingInstrsToCode ilInstrs, attr, imports)
             )
-            |> addMethodGeneratedAttrs
             |> addAltAttribs
+            |> addMethodGeneratedAttrs
 
         mdef
 
@@ -984,8 +988,8 @@ let convAlternativeDef
                                 imports
                             )
                         )
-                        |> addMethodGeneratedAttrs
                         |> addAltAttribs
+                        |> addMethodGeneratedAttrs
 
                     let nullaryProp =
 
@@ -1158,14 +1162,19 @@ let convAlternativeDef
                         let basicFields =
                             fields
                             |> Array.map (fun field ->
-                                let fldName, fldTy = mkUnionCaseFieldId field
+                                let fldName, fldTy, attrs = mkUnionCaseFieldIdAndAttrs g field
+                                let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Assembly)
 
                                 let fdef =
-                                    mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Assembly)
+                                    match attrs with
+                                    | [] -> fdef
+                                    | attrs -> fdef.With(customAttrs = mkILCustomAttrs attrs)
+
                                     |> addFieldNeverAttrs
                                     |> addFieldGeneratedAttrs
 
                                 fdef.WithInitOnly(isTotallyImmutable))
+
                             |> Array.toList
 
                         let basicProps, basicMethods =
@@ -1198,7 +1207,11 @@ let convAlternativeDef
                                  cud.UnionCasesAccessibility)
 
                         let basicCtorFields =
-                            basicFields |> List.map (fun fdef -> fdef.Name, fdef.FieldType)
+                            basicFields
+                            |> List.map (fun fdef ->
+                                let existingAttrs = fdef.CustomAttrs.AsArray()
+                                let nullableAttr = getFieldsNullability g fdef |> Option.toList
+                                fdef.Name, fdef.FieldType, nullableAttr)
 
                         let basicCtorMeth =
                             (mkILStorageCtor (basicCtorInstrs, altTy, basicCtorFields, basicCtorAccess, attr, imports))
@@ -1295,7 +1308,7 @@ let mkClassUnionDef
         | SingleCase
         | RuntimeTypes
         | TailOrNull -> []
-        | IntegerTag -> [ mkTagFieldId g.ilg cuspec ]
+        | IntegerTag -> [ let n, t = mkTagFieldId g.ilg cuspec in n, t, [] ]
 
     let isStruct = td.IsStruct
 
@@ -1320,8 +1333,6 @@ let mkClassUnionDef
                     repr.RepresentAlternativeAsFreshInstancesOfRootClass(info, alt)
                     || repr.RepresentAlternativeAsStructValue info
                 then
-                    // TODO
-                    let fields = alt.FieldDefs |> Array.map mkUnionCaseFieldId |> Array.toList
 
                     let baseInit =
                         if isStruct then
@@ -1337,6 +1348,9 @@ let mkClassUnionDef
                         if isStruct && not (cidx = minNullaryIdx) then
                             []
                         else
+                            let fields =
+                                alt.FieldDefs |> Array.map (mkUnionCaseFieldIdAndAttrs g) |> Array.toList
+
                             [
                                 (mkILSimpleStorageCtor (
                                     baseInit,
@@ -1406,7 +1420,10 @@ let mkClassUnionDef
                         fieldDefs
                         |> Array.filter (fun f -> fieldsEmitted.Add(struct (f.LowerName, f.Type)))
 
-                    let fields = fieldsToBeAddedIntoType |> Array.map mkUnionCaseFieldId |> Array.toList
+                    let fields =
+                        fieldsToBeAddedIntoType
+                        |> Array.map (mkUnionCaseFieldIdAndAttrs g)
+                        |> Array.toList
 
                     let props, meths =
                         mkMethodsAndPropertiesForFields
@@ -1426,9 +1443,14 @@ let mkClassUnionDef
 
     let selfAndTagFields =
         [
-            for fldName, fldTy in (selfFields @ tagFieldsInObject) do
+            for fldName, fldTy, attrs in (selfFields @ tagFieldsInObject) do
                 let fdef =
-                    mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Assembly)
+                    let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Assembly)
+
+                    match attrs with
+                    | [] -> fdef
+                    | attrs -> fdef.With(customAttrs = mkILCustomAttrs attrs)
+
                     |> addFieldNeverAttrs
                     |> addFieldGeneratedAttrs