fix anon recd creation bug (#6434) (#6619)

* fix anon recd creation bug

* fix generation, make it more efficient

* fix feasible equality for anonymous records

src/fsharp/IlxGen.fs

@@ -1356,57 +1356,65 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu
 
     let generateAnonType genToStringMethod (isStruct, ilTypeRef, nms) =
 
-        let flds = [ for (i, nm) in Array.indexed nms -> (nm, nm + "@", ILType.TypeVar (uint16 i)) ]
+        let propTys = [ for (i, nm) in Array.indexed nms -> nm, ILType.TypeVar (uint16 i) ]
+
         // Note that this alternative below would give the same names as C#, but the generated
         // comparison/equality doesn't know about these names.
         //let flds = [ for (i, nm) in Array.indexed nms -> (nm, "<" + nm + ">" + "i__Field", ILType.TypeVar (uint16 i)) ]
+        let ilCtorRef = mkILMethRef(ilTypeRef, ILCallingConv.Instance, ".ctor", 0, List.map snd propTys, ILType.Void)
 
-        let ilGenericParams =
-            [ for nm in nms ->
-                { Name = sprintf "<%s>j__TPar" nm
-                  Constraints = []
-                  Variance=NonVariant
-                  CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
-                  HasReferenceTypeConstraint=false
-                  HasNotNullableValueTypeConstraint=false
-                  HasDefaultConstructorConstraint= false
-                  MetadataIndex = NoMetadataIdx } ]
+        let ilMethodRefs = 
+            [| for (propName, propTy) in propTys ->
+                   mkILMethRef (ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], propTy) |]
 
-        let ilTy = mkILFormalNamedTy (if isStruct then ILBoxity.AsValue else ILBoxity.AsObject) ilTypeRef ilGenericParams
+        let ilTy = mkILNamedTy (if isStruct then ILBoxity.AsValue else ILBoxity.AsObject) ilTypeRef (List.map snd propTys)
 
-        // Generate the IL fields
-        let ilFieldDefs =
-            mkILFields
-                [ for (_, fldName, fldTy) in flds ->
-                    let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Private)
-                    fdef.With(customAttrs = mkILCustomAttrs [ g.DebuggerBrowsableNeverAttribute ]) ]
+        if ilTypeRef.Scope.IsLocalRef then
+
+            let flds = [ for (i, nm) in Array.indexed nms -> (nm, nm + "@", ILType.TypeVar (uint16 i)) ]
+
+            let ilGenericParams =
+                [ for nm in nms ->
+                    { Name = sprintf "<%s>j__TPar" nm
+                      Constraints = []
+                      Variance=NonVariant
+                      CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
+                      HasReferenceTypeConstraint=false
+                      HasNotNullableValueTypeConstraint=false
+                      HasDefaultConstructorConstraint= false
+                      MetadataIndex = NoMetadataIdx } ]
+
+            let ilTy = mkILFormalNamedTy (if isStruct then ILBoxity.AsValue else ILBoxity.AsObject) ilTypeRef ilGenericParams
+
+            // Generate the IL fields
+            let ilFieldDefs =
+                mkILFields
+                    [ for (_, fldName, fldTy) in flds ->
+                        let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Private)
+                        fdef.With(customAttrs = mkILCustomAttrs [ g.DebuggerBrowsableNeverAttribute ]) ]
 
-        // Generate property definitions for the fields compiled as properties
-        let ilProperties =
-            mkILProperties
-                [ for (i, (propName, _fldName, fldTy)) in List.indexed flds ->
-                        ILPropertyDef(name=propName,
-                          attributes=PropertyAttributes.None,
-                          setMethod=None,
-                          getMethod=Some(mkILMethRef(ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], fldTy )),
-                          callingConv=ILCallingConv.Instance.ThisConv,
-                          propertyType=fldTy,
-                          init= None,
-                          args=[],
-                          customAttrs=mkILCustomAttrs [ mkCompilationMappingAttrWithSeqNum g (int SourceConstructFlags.Field) i ]) ]
+            // Generate property definitions for the fields compiled as properties
+            let ilProperties =
+                mkILProperties
+                    [ for (i, (propName, _fldName, fldTy)) in List.indexed flds ->
+                            ILPropertyDef(name=propName,
+                              attributes=PropertyAttributes.None,
+                              setMethod=None,
+                              getMethod=Some(mkILMethRef(ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], fldTy )),
+                              callingConv=ILCallingConv.Instance.ThisConv,
+                              propertyType=fldTy,
+                              init= None,
+                              args=[],
+                              customAttrs=mkILCustomAttrs [ mkCompilationMappingAttrWithSeqNum g (int SourceConstructFlags.Field) i ]) ]
 
-        let ilMethods =
-            [ for (propName, fldName, fldTy) in flds ->
-                    mkLdfldMethodDef ("get_" + propName, ILMemberAccess.Public, false, ilTy, fldName, fldTy)
-              yield! genToStringMethod ilTy ]
+            let ilMethods =
+                [ for (propName, fldName, fldTy) in flds ->
+                        mkLdfldMethodDef ("get_" + propName, ILMemberAccess.Public, false, ilTy, fldName, fldTy)
+                  yield! genToStringMethod ilTy ]
 
-        let ilBaseTy = (if isStruct then g.iltyp_ValueType else g.ilg.typ_Object)
+            let ilBaseTy = (if isStruct then g.iltyp_ValueType else g.ilg.typ_Object)
 
-        let ilCtorDef = mkILSimpleStorageCtorWithParamNames(None, (if isStruct then None else Some ilBaseTy.TypeSpec), ilTy, [], flds, ILMemberAccess.Public)
-        let ilCtorRef = mkRefToILMethod(ilTypeRef, ilCtorDef)
-        let ilMethodRefs = [| for mdef in ilMethods -> mkRefToILMethod(ilTypeRef, mdef) |]
-
-        if ilTypeRef.Scope.IsLocalRef then
+            let ilCtorDef = mkILSimpleStorageCtorWithParamNames(None, (if isStruct then None else Some ilBaseTy.TypeSpec), ilTy, [], flds, ILMemberAccess.Public)
 
             // Create a tycon that looks exactly like a record definition, to help drive the generation of equality/comparison code
             let m = range0
@@ -1482,12 +1490,12 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu
     /// static init fields on script modules.
     let mutable scriptInitFspecs: (ILFieldSpec * range) list = []
 
-    member mgbuf.AddScriptInitFieldSpec(fieldSpec, range) =
+    member __.AddScriptInitFieldSpec (fieldSpec, range) =
         scriptInitFspecs <- (fieldSpec, range) :: scriptInitFspecs
 
     /// This initializes the script in #load and fsc command-line order causing their
     /// sideeffects to be executed.
-    member mgbuf.AddInitializeScriptsInOrderToEntryPoint() =
+    member mgbuf.AddInitializeScriptsInOrderToEntryPoint () =
         // Get the entry point and initialized any scripts in order.
         match explicitEntryPointInfo with
         | Some tref ->
@@ -1496,57 +1504,54 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu
             scriptInitFspecs |> List.iter IntializeCompiledScript
         | None -> ()
 
-    member mgbuf.GenerateRawDataValueType(cloc, size) =
+    member __.GenerateRawDataValueType (cloc, size) =
         // Byte array literals require a ValueType of size the required number of bytes.
         // With fsi.exe, S.R.Emit TypeBuilder CreateType has restrictions when a ValueType VT is nested inside a type T, and T has a field of type VT.
         // To avoid this situation, these ValueTypes are generated under the private implementation rather than in the current cloc. [was bug 1532].
         let cloc = CompLocForPrivateImplementationDetails cloc
         rawDataValueTypeGenerator.Apply((cloc, size))
 
-    member mgbuf.GenerateAnonType(genToStringMethod, anonInfo: AnonRecdTypeInfo) =
+    member __.GenerateAnonType (genToStringMethod, anonInfo: AnonRecdTypeInfo) =
         let isStruct = evalAnonInfoIsStruct anonInfo
         let key = anonInfo.Stamp
-        match anonTypeTable.Table.TryGetValue key with
-        | true, res -> res
-        | _ ->
+        if not (anonTypeTable.Table.ContainsKey key) then
             let info = generateAnonType genToStringMethod (isStruct, anonInfo.ILTypeRef, anonInfo.SortedNames)
             anonTypeTable.Table.[key] <- info
-            info
 
-    member mgbuf.LookupAnonType(anonInfo: AnonRecdTypeInfo) =
+    member __.LookupAnonType (anonInfo: AnonRecdTypeInfo) =
         match anonTypeTable.Table.TryGetValue anonInfo.Stamp with
         | true, res -> res
         | _ -> failwithf "the anonymous record %A has not been generated in the pre-phase of generating this module" anonInfo.ILTypeRef
 
-    member mgbuf.GrabExtraBindingsToGenerate() =
+    member __.GrabExtraBindingsToGenerate () =
         let result = extraBindingsToGenerate
         extraBindingsToGenerate <- []
         result
 
-    member mgbuf.AddTypeDef(tref: ILTypeRef, tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) =
+    member __.AddTypeDef (tref: ILTypeRef, tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) =
         gtdefs.FindNestedTypeDefsBuilder(tref.Enclosing).AddTypeDef(tdef, eliminateIfEmpty, addAtEnd, tdefDiscards)
 
-    member mgbuf.GetCurrentFields(tref: ILTypeRef) =
+    member __.GetCurrentFields (tref: ILTypeRef) =
         gtdefs.FindNestedTypeDefBuilder(tref).GetCurrentFields()
 
-    member mgbuf.AddReflectedDefinition(vspec: Tast.Val, expr) =
+    member __.AddReflectedDefinition (vspec: Tast.Val, expr) =
         // preserve order by storing index of item
         let n = reflectedDefinitions.Count
         reflectedDefinitions.Add(vspec, (vspec.CompiledName, n, expr))
 
-    member mgbuf.ReplaceNameOfReflectedDefinition(vspec, newName) =
+    member __.ReplaceNameOfReflectedDefinition (vspec, newName) =
         match reflectedDefinitions.TryGetValue vspec with
         | true, (name, n, expr) when name <> newName -> reflectedDefinitions.[vspec] <- (newName, n, expr)
         | _ -> ()
 
-    member mgbuf.AddMethodDef(tref: ILTypeRef, ilMethodDef) =
+    member __.AddMethodDef (tref: ILTypeRef, ilMethodDef) =
         gtdefs.FindNestedTypeDefBuilder(tref).AddMethodDef(ilMethodDef)
         if ilMethodDef.IsEntryPoint then
             explicitEntryPointInfo <- Some tref
 
-    member mgbuf.AddExplicitInitToSpecificMethodDef(cond, tref, fspec, sourceOpt, feefee, seqpt) =
-    // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field
-    // Doing both a store and load keeps FxCop happier because it thinks the field is useful
+    member __.AddExplicitInitToSpecificMethodDef (cond, tref, fspec, sourceOpt, feefee, seqpt) =
+        // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field
+        // Doing both a store and load keeps FxCop happier because it thinks the field is useful
         let instrs =
             [ yield! (if condition "NO_ADD_FEEFEE_TO_CCTORS" then [] elif condition "ADD_SEQPT_TO_CCTORS" then seqpt else feefee) // mark start of hidden code
               yield mkLdcInt32 0
@@ -1555,25 +1560,26 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu
               yield AI_pop]
         gtdefs.FindNestedTypeDefBuilder(tref).PrependInstructionsToSpecificMethodDef(cond, instrs, sourceOpt)
 
-    member mgbuf.AddEventDef(tref, edef) =
+    member __.AddEventDef (tref, edef) =
         gtdefs.FindNestedTypeDefBuilder(tref).AddEventDef(edef)
 
-    member mgbuf.AddFieldDef(tref, ilFieldDef) =
+    member __.AddFieldDef (tref, ilFieldDef) =
         gtdefs.FindNestedTypeDefBuilder(tref).AddFieldDef(ilFieldDef)
 
-    member mgbuf.AddOrMergePropertyDef(tref, pdef, m) =
+    member __.AddOrMergePropertyDef (tref, pdef, m) =
         gtdefs.FindNestedTypeDefBuilder(tref).AddOrMergePropertyDef(pdef, m)
 
-    member mgbuf.Close() =
+    member __.Close() =
         // old implementation adds new element to the head of list so result was accumulated in reversed order
         let orderedReflectedDefinitions =
             [for (KeyValue(vspec, (name, n, expr))) in reflectedDefinitions -> n, ((name, vspec), expr)]
             |> List.sortBy (fst >> (~-)) // invert the result to get 'order-by-descending' behavior (items in list are 0..* so we don't need to worry about int.MinValue)
             |> List.map snd
         gtdefs.Close(), orderedReflectedDefinitions
-    member mgbuf.cenv = cenv
-    member mgbuf.GetExplicitEntryPointInfo() = explicitEntryPointInfo
 
+    member __.cenv = cenv
+
+    member __.GetExplicitEntryPointInfo() = explicitEntryPointInfo
 
 /// Record the types of the things on the evaluation stack.
 /// Used for the few times we have to flush the IL evaluation stack and to compute maxStack.
@@ -6408,7 +6414,7 @@ and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile (qname,
 
     // Generate all the anonymous record types mentioned anywhere in this module
     for anonInfo in anonRecdTypes.Values do
-        mgbuf.GenerateAnonType((fun ilThisTy -> GenToStringMethod cenv eenv ilThisTy m), anonInfo) |> ignore
+        mgbuf.GenerateAnonType((fun ilThisTy -> GenToStringMethod cenv eenv ilThisTy m), anonInfo)
 
     let eenv = {eenv with cloc = { eenv.cloc with TopImplQualifiedName = qname.Text } }
 
@@ -7615,7 +7621,6 @@ let ClearGeneratedValue (ctxt: ExecutionContext) (_g: TcGlobals) eenv (v: Val) =
 #endif
       ()
 
-
 /// The published API from the ILX code generator
 type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: ConstraintSolver.TcValF, ccu: Tast.CcuThunk) =
 

src/fsharp/PostInferenceChecks.fs

@@ -285,6 +285,10 @@ let BindVal cenv env (v: Val) =
 
 let BindVals cenv env vs = List.iter (BindVal cenv env) vs
 
+let RecordAnonRecdInfo cenv (anonInfo: AnonRecdTypeInfo) =
+    if not (cenv.anonRecdTypes.ContainsKey anonInfo.Stamp) then 
+         cenv.anonRecdTypes <- cenv.anonRecdTypes.Add(anonInfo.Stamp, anonInfo)
+
 //--------------------------------------------------------------------------
 // approx walk of type
 //--------------------------------------------------------------------------
@@ -334,8 +338,7 @@ let rec CheckTypeDeep (cenv: cenv) ((visitTy, visitTyconRefOpt, visitAppTyOpt, v
         | Some visitAppTy -> visitAppTy (tcref, tinst)
         | None -> ()
     | TType_anon (anonInfo, tys) -> 
-        if not (cenv.anonRecdTypes.ContainsKey anonInfo.Stamp) then 
-             cenv.anonRecdTypes <- cenv.anonRecdTypes.Add(anonInfo.Stamp, anonInfo)
+        RecordAnonRecdInfo cenv anonInfo
         CheckTypesDeep cenv f g env tys
 
     | TType_ucase (_, tinst) -> CheckTypesDeep cenv f g env tinst
@@ -1011,8 +1014,8 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi
         CheckValRef cenv env baseVal m PermitByRefExpr.No
         CheckExprsPermitByRefLike cenv env rest
 
-    | Expr.Op (c, tyargs, args, m) ->
-        CheckExprOp cenv env (c, tyargs, args, m) context expr
+    | Expr.Op (op, tyargs, args, m) ->
+        CheckExprOp cenv env (op, tyargs, args, m) context expr
 
     // Allow 'typeof<System.Void>' calls as a special case, the only accepted use of System.Void! 
     | TypeOfExpr g ty when isVoidTy g ty ->
@@ -1115,7 +1118,14 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr =
     let ctorLimitedZoneCheck() = 
         if env.ctorLimitedZone then errorR(Error(FSComp.SR.chkObjCtorsCantUseExceptionHandling(), m))
 
-    (* Special cases *)
+    // Ensure anonynous record type requirements are recorded
+    match op with
+    | TOp.AnonRecdGet (anonInfo, _) 
+    | TOp.AnonRecd anonInfo -> 
+        RecordAnonRecdInfo cenv anonInfo
+    | _ -> ()
+
+    // Special cases
     match op, tyargs, args with 
     // Handle these as special cases since mutables are allowed inside their bodies 
     | TOp.While _, _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _)]  ->

src/fsharp/TypeRelations.fs

@@ -66,18 +66,28 @@ let rec TypesFeasiblyEquiv ndeep g amap m ty1 ty2 =
     let ty1 = stripTyEqns g ty1
     let ty2 = stripTyEqns g ty2
     match ty1, ty2 with 
-    // QUERY: should these be false for non-equal rigid typars? warn-if-not-rigid typars?
     | TType_var _, _  
     | _, TType_var _ -> true
+
     | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2  ->  
         List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2
+
+    | TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2)      -> 
+        (evalTupInfoIsStruct anonInfo1.TupInfo = evalTupInfoIsStruct anonInfo2.TupInfo) &&
+        (match anonInfo1.Assembly, anonInfo2.Assembly with ccu1, ccu2 -> ccuEq ccu1 ccu2) &&
+        (anonInfo1.SortedNames = anonInfo2.SortedNames) &&
+        List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2
+
     | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2)     -> 
         evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 &&
         List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 
+
     | TType_fun (d1, r1), TType_fun (d2, r2)   -> 
         (TypesFeasiblyEquiv ndeep g amap m) d1 d2 && (TypesFeasiblyEquiv ndeep g amap m) r1 r2
+
     | TType_measure _, TType_measure _ ->
         true
+
     | _ -> 
         false
 
@@ -88,18 +98,18 @@ let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 =
     let ty1 = stripTyEqns g ty1
     let ty2 = stripTyEqns g ty2
     match ty1, ty2 with 
-    // QUERY: should these be false for non-equal rigid typars? warn-if-not-rigid typars?
     | TType_var _, _  | _, TType_var _ -> true
 
     | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2  ->  
         List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2
-    | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2)     -> 
-        evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 && 
-        List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 
-    | TType_fun (d1, r1), TType_fun (d2, r2)   -> 
-        (TypesFeasiblyEquiv ndeep g amap m) d1 d2 && (TypesFeasiblyEquiv ndeep g amap m) r1 r2
+
+    | TType_tuple _, TType_tuple _
+    | TType_anon _, TType_anon _
+    | TType_fun _, TType_fun _ -> TypesFeasiblyEquiv ndeep g amap m ty1 ty2
+
     | TType_measure _, TType_measure _ ->
         true
+
     | _ -> 
         // F# reference types are subtypes of type 'obj' 
         (isObjTy g ty1 && (canCoerce = CanCoerce || isRefTy g ty2)) 

tests/fsharp/core/anon/test.fsx

@@ -67,6 +67,18 @@ module CrossAssemblyTestTupleStruct =
         check "svrknvio4" (let res = SampleAPITupleStruct.SampleFunctionReturningStructTuple() in match res with (x,y) -> x + y.Length) 4 
     tests()
 
+module TypeNotGeneratedBug = 
+
+    let foo (_: obj) = ()
+
+    let bar() = foo {| ThisIsUniqueToThisTest6353 = 1 |}
+
+module FeasibleEqualityNotImplemented = 
+    type R = {| number: int |}
+    let e = Event< R>()
+    e.Trigger {|number = 3|}
+    e.Publish.Add (printfn "%A")    // error
+
 #if TESTS_AS_APP
 let RUN() = !failures
 #else