Allow use of multi interface instantiations

src/fsharp/FSComp.txt

@@ -290,7 +290,7 @@ chkUnionCaseDefaultAugmentation,"default augmentation of the union case"
 441,chkDuplicatePropertyWithSuffix,"Duplicate property. The property '%s' has the same name and signature as another property in this type once tuples, functions, units of measure and/or provided types are erased."
 442,chkDuplicateMethodInheritedType,"Duplicate method. The abstract method '%s' has the same name and signature as an abstract method in an inherited type."
 442,chkDuplicateMethodInheritedTypeWithSuffix,"Duplicate method. The abstract method '%s' has the same name and signature as an abstract method in an inherited type once tuples, functions, units of measure and/or provided types are erased."
-443,chkMultipleGenericInterfaceInstantiations,"This type implements or inherits the same interface at different generic instantiations '%s' and '%s'. This is not permitted in this version of F#."
+443,chkMultipleGenericInterfaceInstantiations,"This type implements the same interface at different generic instantiations '%s' and '%s'. This is not permitted in this version of F#."
 444,chkValueWithDefaultValueMustHaveDefaultValue,"The type of a field using the 'DefaultValue' attribute must admit default initialization, i.e. have 'null' as a proper value or be a struct type whose fields all admit default initialization. You can use 'DefaultValue(false)' to disable this check"
 445,chkNoByrefInTypeAbbrev,"The type abbreviation contains byrefs. This is not permitted by F#."
 # -----------------------------------------------------------------------------

src/fsharp/NicePrint.fs

@@ -1390,8 +1390,7 @@ module private TastDefinitionPrinting =
                 GetImmediateInterfacesOfType g amap m ty |> List.map (fun ity -> wordL (if isInterfaceTy g ty then "inherit" else "interface") --- layoutType denv ity)
 
         let props = 
-            //GetImmediateIntrinsicPropInfosOfType  (None,ad) g amap m ty 
-            GetIntrinsicPropInfosOfType infoReader (None,ad,AllowMultiIntfInstantiations.No)  PreferOverrides m ty 
+            GetIntrinsicPropInfosOfType infoReader (None,ad,AllowMultiIntfInstantiations.Yes)  PreferOverrides m ty 
 
         let events = 
             infoReader.GetEventInfosOfType(None,ad,m,ty) 

src/fsharp/check.fs

@@ -490,9 +490,10 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) =
           CheckInterfaceImpls cenv env basev iimpls;
           CheckTypePermitByrefs cenv m typ
           let interfaces = 
-              [ yield! AllSuperTypesOfType cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes typ
+              [ if isInterfaceTy cenv.g typ then 
+                    yield! AllSuperTypesOfType cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes typ
                 for (ty,_) in iimpls do
-                    yield! AllSuperTypesOfType cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes ty ]
+                    yield! AllSuperTypesOfType cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes ty  ]
               |> List.filter (isInterfaceTy cenv.g)
           CheckMultipleInterfaceInstantiations cenv interfaces m
 
@@ -1367,6 +1368,11 @@ let CheckEntityDefn cenv env (tycon:Entity) =
 
     if cenv.reportErrors then 
         if not tycon.IsTypeAbbrev then 
+            let typ = generalizedTyconRef (mkLocalTyconRef tycon)
+            let immediateInterfaces = GetImmediateInterfacesOfType cenv.g cenv.amap m typ
+            let interfaces = 
+              [ for ty in immediateInterfaces do
+                    yield! AllSuperTypesOfType cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes ty  ]
             CheckMultipleInterfaceInstantiations cenv interfaces m
 
         // Check struct fields. We check these late because we have to have first checked that the structs are

src/fsharp/infos.fs

@@ -215,7 +215,7 @@ let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst typ =
 
 /// Search for one element where a function returns a 'Some' result, following interfaces
 let SearchEntireHierarchyOfType f g amap m typ = 
-    FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.No
+    FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes
         (fun ty acc -> 
             match acc with 
             | None -> if f ty then Some(ty) else None 
@@ -243,11 +243,11 @@ let HasHeadType g tcref ty2 =
 
 /// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all)
 let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = 
-    ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor)  g amap m AllowMultiIntfInstantiations.No typeToSearchFrom
+    ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor)  g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom
 
 /// Check if a type exists somewhere in the hierarchy which has the given head type.
 let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = 
-    ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.No typeToSearchFrom
+    ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom
 
 
 /// Read an Abstract IL type from metadata and convert to an F# type.
@@ -3127,13 +3127,13 @@ type InfoReader(g:TcGlobals, amap:Import.ImportMap) =
         FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicPropInfosOfType (optFilter,ad) g amap m typ :: acc) g amap m allowMultiIntfInst typ []
 
     let GetIntrinsicILFieldInfosUncached ((optFilter,ad),m,typ) =
-        FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicILFieldsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.No typ []
+        FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicILFieldsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []
 
     let GetIntrinsicEventInfosUncached ((optFilter,ad),m,typ) =
-        FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicEventsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.No typ []
+        FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicEventsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []
 
     let GetIntrinsicRecdOrClassFieldInfosUncached ((optFilter,ad),m,typ) =
-        FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.No typ []
+        FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []
 
     let GetEntireTypeHierachyUncached (allowMultiIntfInst,m,typ) =
         FoldEntireHierarchyOfType (fun typ acc -> typ :: acc) g amap m allowMultiIntfInst typ  [] 
@@ -3164,7 +3164,7 @@ type InfoReader(g:TcGlobals, amap:Import.ImportMap) =
                 | _ -> failwith "Unexpected multiple fields with the same name" // Because an explicit name (i.e., nm) was supplied, there will be only one element at most.
              | _ -> acc)
           g amap m 
-          AllowMultiIntfInstantiations.No
+          AllowMultiIntfInstantiations.Yes
           typ
           None
 
@@ -3506,12 +3506,12 @@ let TryFindIntrinsicNamedItemOfType (infoReader:InfoReader) (nm,ad) findFlag m t
 ///     -- getting the Dispose method when resolving the 'use' construct 
 ///     -- getting the various methods used to desugar the computation expression syntax 
 let TryFindIntrinsicMethInfo infoReader m ad nm ty = 
-    GetIntrinsicMethInfosOfType infoReader (Some nm,ad,AllowMultiIntfInstantiations.No) IgnoreOverrides m ty 
+    GetIntrinsicMethInfosOfType infoReader (Some nm,ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m ty 
 
 /// Try to find a particular named property on a type. Only used to ensure that local 'let' definitions and property names
 /// are distinct, a somewhat adhoc check in tc.fs.
 let TryFindPropInfo infoReader m ad nm ty = 
-    GetIntrinsicPropInfosOfType infoReader (Some nm,ad,AllowMultiIntfInstantiations.No) IgnoreOverrides m ty 
+    GetIntrinsicPropInfosOfType infoReader (Some nm,ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m ty 
 
 //-------------------------------------------------------------------------
 // Helpers related to delegates and events
@@ -3528,7 +3528,7 @@ let GetSigOfFunctionForDelegate (infoReader:InfoReader) delty m ad =
     let g = infoReader.g
     let amap = infoReader.amap
     let invokeMethInfo = 
-        match GetIntrinsicMethInfosOfType infoReader (Some "Invoke",ad,AllowMultiIntfInstantiations.No) IgnoreOverrides m delty with 
+        match GetIntrinsicMethInfosOfType infoReader (Some "Invoke",ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m delty with 
         | [h] -> h
         | [] -> error(Error(FSComp.SR.noInvokeMethodsFound (),m))
         | h :: _ -> warning(InternalError(FSComp.SR.moreThanOneInvokeMethodFound (),m)); h

src/fsharp/nameres.fs

@@ -1030,7 +1030,7 @@ let MakeNestedType (ncenv:NameResolver) (tinst:TType list) m (tcrefNested:TyconR
 /// Get all the accessible nested types of an existing type.
 let GetNestedTypesOfType (ad, ncenv:NameResolver, optFilter, staticResInfo, checkForGenerated, m) typ =
     let g = ncenv.g
-    ncenv.InfoReader.GetPrimaryTypeHierachy(AllowMultiIntfInstantiations.No,m,typ) |> List.collect (fun typ -> 
+    ncenv.InfoReader.GetPrimaryTypeHierachy(AllowMultiIntfInstantiations.Yes,m,typ) |> List.collect (fun typ -> 
         if isAppTy g typ then 
             let tcref,tinst = destAppTy g typ
             let tycon = tcref.Deref
@@ -1372,7 +1372,7 @@ let ResolveObjectConstructor (ncenv:NameResolver) edenv m ad typ =
 let IntrinsicPropInfosOfTypeInScope (infoReader:InfoReader) (optFilter, ad) findFlag m typ =
     let g = infoReader.g
     let amap = infoReader.amap
-    let pinfos = GetIntrinsicPropInfoSetsOfType infoReader (optFilter, ad, AllowMultiIntfInstantiations.No) findFlag m typ
+    let pinfos = GetIntrinsicPropInfoSetsOfType infoReader (optFilter, ad, AllowMultiIntfInstantiations.Yes) findFlag m typ
     let pinfos = pinfos |> ExcludeHiddenOfPropInfos g amap m 
     pinfos
 
@@ -1400,7 +1400,7 @@ let ExtensionPropInfosOfTypeInScope (infoReader:InfoReader) (nenv: NameResolutio
     let g = infoReader.g
 
     let extMemsFromHierarchy = 
-        infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.No,m,typ) |> List.collect (fun typ -> 
+        infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes,m,typ) |> List.collect (fun typ -> 
              if (isAppTy g typ) then 
                 let tcref = tcrefOfAppTy g typ
                 let extMemInfos = nenv.eIndexedExtensionMembers.Find tcref
@@ -1462,7 +1462,7 @@ let SelectMethInfosFromExtMembers (infoReader:InfoReader) optFilter apparentTy m
 let ExtensionMethInfosOfTypeInScope (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter m typ =
     let extMemsDangling = SelectMethInfosFromExtMembers  infoReader optFilter typ  m nenv.eUnindexedExtensionMembers
     let extMemsFromHierarchy = 
-        infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.No,m,typ) |> List.collect (fun typ -> 
+        infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes,m,typ) |> List.collect (fun typ -> 
             let g = infoReader.g
             if (isAppTy g typ) then 
                 let tcref = tcrefOfAppTy g typ
@@ -1473,7 +1473,7 @@ let ExtensionMethInfosOfTypeInScope (infoReader:InfoReader) (nenv: NameResolutio
 
 /// Get all the available methods of a type (both intrinsic and extension)
 let AllMethInfosOfTypeInScope infoReader nenv (optFilter,ad) findFlag m typ =
-    IntrinsicMethInfosOfType infoReader (optFilter,ad,AllowMultiIntfInstantiations.No) findFlag m typ 
+    IntrinsicMethInfosOfType infoReader (optFilter,ad,AllowMultiIntfInstantiations.Yes) findFlag m typ 
     @ ExtensionMethInfosOfTypeInScope infoReader nenv optFilter m typ          
 
 

src/fsharp/tastops.fs

@@ -1246,6 +1246,7 @@ type TyconRefMultiMap<'T>(contents: TyconRefMap<'T list>) =
     member m.Find v = if contents.ContainsKey v then contents.[v] else []
     member m.Add (v, x) = TyconRefMultiMap<'T>(contents.Add v (x :: m.Find v))
     static member Empty = TyconRefMultiMap<'T>(TyconRefMap<_>.Empty)
+    static member OfList vs = (vs, TyconRefMultiMap<'T>.Empty) ||> List.foldBack (fun (x,y) acc -> acc.Add (x, y)) 
 
 
 //--------------------------------------------------------------------------

src/fsharp/tastops.fsi

@@ -279,6 +279,7 @@ type TyconRefMultiMap<'T> =
     member Find : TyconRef -> 'T list
     member Add : TyconRef * 'T -> TyconRefMultiMap<'T>
     static member Empty : TyconRefMultiMap<'T>
+    static member OfList : (TyconRef * 'T) list -> TyconRefMultiMap<'T>
 
 
 //-------------------------------------------------------------------------

src/fsharp/tc.fs

@@ -121,7 +121,7 @@ let IsSecurityAttribute g amap (casmap : Dictionary<Stamp,bool>) (Attrib(tcref,_
            if casmap.ContainsKey(tcs) then
              casmap.[tcs]
            else
-             let exists = ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkAppTy attr.TyconRef [])) g amap m AllowMultiIntfInstantiations.No (mkAppTy tcref [])
+             let exists = ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkAppTy attr.TyconRef [])) g amap m AllowMultiIntfInstantiations.Yes (mkAppTy tcref [])
              casmap.[tcs] <- exists
              exists
         | _ -> false  
@@ -5639,7 +5639,7 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg
               cenv.g 
               cenv.amap 
               mWholeExpr 
-              AllowMultiIntfInstantiations.No
+              AllowMultiIntfInstantiations.Yes
               e1ty
               None
         | _ -> Some "GetSlice"
@@ -14225,7 +14225,7 @@ module EstablishTypeDefinitionCores = begin
             // validate ConditionalAttribute, should it be applied (it's only valid on a type if the type is an attribute type)
             match attrs |> List.tryFind (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_ConditionalAttribute) with
             | Some _ ->
-                if not(ExistsInEntireHierarchyOfType (fun t -> typeEquiv cenv.g t (mkAppTy cenv.g.tcref_System_Attribute [])) cenv.g cenv.amap m AllowMultiIntfInstantiations.No thisTy) then
+                if not(ExistsInEntireHierarchyOfType (fun t -> typeEquiv cenv.g t (mkAppTy cenv.g.tcref_System_Attribute [])) cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes thisTy) then
                     errorR(Error(FSComp.SR.tcConditionalAttributeUsage(),m))
             | _ -> ()         
 

src/fsharp/typrelns.fs

@@ -1282,7 +1282,7 @@ module DispatchSlotChecking =
         // This contains the list of required members and the list of available members
         [ for (_,reqdTy,reqdTyRange,impliedTys) in reqdTyInfos do
 
-            // Build a table of the implied interface types, for quicker lookup
+            // Build a set of the implied interface types, for quicker lookup, by nominal type
             let isImpliedInterfaceTable = 
                 impliedTys 
                 |> List.filter (isInterfaceTy g) 
@@ -1721,7 +1721,7 @@ type CalledMeth<'T>
                 let returnedObjTy = if minfo.IsConstructor then minfo.EnclosingType else methodRetTy
                 unassignedNamedItem |> List.splitChoose (fun (CallerNamedArg(id,e) as arg) -> 
                     let nm = id.idText
-                    let pinfos = GetIntrinsicPropInfoSetsOfType infoReader (Some(nm),ad,AllowMultiIntfInstantiations.No) IgnoreOverrides id.idRange returnedObjTy
+                    let pinfos = GetIntrinsicPropInfoSetsOfType infoReader (Some(nm),ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides id.idRange returnedObjTy
                     let pinfos = pinfos |> ExcludeHiddenOfPropInfos g infoReader.amap m 
                     match pinfos with 
                     | [pinfo] when pinfo.HasSetter && not pinfo.IsIndexer -> 

tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/GeneratedEqualityHashingComparison/Attributes/New/Test06.fs

@@ -1,5 +1,5 @@
 // #Regression #Conformance #TypesAndModules #GeneratedEqualityAndHashing #Attributes 
-//<Expects status="error" span="(9,8-9,9)" id="FS0377">This type uses an invalid mix of the attributes 'NoEquality', 'ReferenceEquality', 'StructuralEquality', 'NoComparison' and 'StructuralComparison' attributes$</Expects>
+//<Expects status="error" span="(9,8-9,9)" id="FS0377">This type uses an invalid mix of the attributes 'NoEquality', 'ReferenceEquality', 'StructuralEquality', 'NoComparison' and 'StructuralComparison'$</Expects>
 //<Expects status="error" span="(9,8-9,9)" id="FS0385">A type with attribute 'CustomComparison' must have an explicit implementation of at least one of 'System\.IComparable' or 'System\.Collections\.IStructuralComparable'$</Expects>
 
 module M06 = 

tests/fsharpqa/Source/Conformance/Expressions/DataExpressions/ObjectExpressions/E_ObjExprWithSameInterface01.fs

@@ -1,6 +1,6 @@
 // #Regression #Conformance #DataExpressions #ObjectConstructors 
 // This was Dev10:854519 and Dev11:5525. The fix was to make this a compile error to avoid a runtime exception.
-//<Expects status="error" span="(13,5-16,31)" id="FS0443">This type implements or inherits the same interface at different generic instantiations 'IQueue<'T>' and 'IQueue<obj>'\. This is not permitted in this version of F#\.$</Expects>
+//<Expects status="error" span="(13,5-16,31)" id="FS0443">This type implements the same interface at different generic instantiations 'IQueue<'T>' and 'IQueue<obj>'\. This is not permitted in this version of F#\.$</Expects>
 
 type IQueue<'a> =
     abstract Addd: 'a -> IQueue<'a>

tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/InterfaceTypes/ConsumeMultipleInterfaceFromCS.fs

@@ -1,5 +1,5 @@
 // #Conformance #ObjectOrientedTypes #InterfacesAndImplementations #ReqNOMT 
-#light
+#light	
 
 let mutable res = true
 let t = new T()
@@ -15,17 +15,28 @@ if (t.Home(0) <> 0) then
   System.Console.WriteLine("t.Home failed")
   res <- false
 
-if ( {new I_003<int> with 
-               member xxx.Home(i) = i
-               member xxx.Me(c:char) = 0
-               member xxx.Me(s:string) = 0
-      }.Home (
-        {new I_002<int> with 
-          member x.Me (s) = s
-        }.Me(0) )  <> 0 ) then
-            System.Console.WriteLine("I_003.Home failed")         
+// Check we can use an object expression inheriting from a C# type implementing multiple instantiations of an interface
+if (({new T() with 
+               member x.ToString() = "a"
+      } :> I_003<int>).Home (4)  <> 0 ) then
+            System.Console.WriteLine("T.Home obj expr failed")         
             res <- false
 
+// Check we can create an object of a C# type implementing multiple instantiations of an interface
+if T().Home(4) <> 0 then
+            System.Console.WriteLine("T.Home failed")         
+            res <- false
+
+
+// Check we can inherit from a C# type implementing multiple instantiations of an interface
+type D() = 
+    inherit T()
+
+if (D() :> I_003<int>).Home(5) <> 0 then
+            System.Console.WriteLine("D.Home failed")         
+            res <- false
+
+
 if (res = true) then
     exit 0
 

tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/InterfaceTypes/E_ClassConsumeMultipleInterfaceFromCS.fs

@@ -0,0 +1,23 @@
+// #Conformance #ObjectOrientedTypes #InterfacesAndImplementations #ReqNOMT 
+// <Expects id="FS0443" status="error" span="(8,6-8,7)">This type implements the same interface at different generic instantiations 'I_002\<string\>' and 'I_002\<char\>'\. This is not permitted in this version of F#\.</Expects>
+#light	
+
+let mutable res = true
+
+// Check we can't implement an interface inheriting from multiple instantiations of an interface when defining an object expression inheriting from a C# class type
+type D() = 
+    inherit T()
+    interface I_003<int> with
+       member xxx.Home(i) = i
+
+if (D() :> I_003<int>).Home(5) <> 5 then
+            System.Console.WriteLine("D.Home failed")         
+            res <- false
+
+
+if (res = true) then
+    exit 0
+
+
+exit 1
+