Merge pull request #430 from Jand42/master

Exposing implemented abstract slots

Author: dsyme

src/fsharp/infos.fs

@@ -375,6 +375,11 @@ type ValRef with
          | TSlotSig(_,oty,_,_,_,_) :: _ -> isInterfaceTy g oty
          | [] -> false)
 
+    member vref.ImplementedSlotSignatures =
+        match vref.MemberInfo with
+        | None -> []
+        | Some membInfo -> membInfo.ImplementedSlotSigs
+
 //-------------------------------------------------------------------------
 // Helper methods associated with using TAST metadata (F# members, values etc.) 
 // as backing data for MethInfo, PropInfo etc.
@@ -1090,6 +1095,11 @@ type MethInfo =
         | ProvidedMeth _ -> false 
 #endif
 
+    member x.ImplementedSlotSignatures =
+        match x with 
+        | FSMeth(_,_,vref,_) -> vref.ImplementedSlotSignatures
+        | _ -> failwith "not supported"
+
     /// Indicates if this is an extension member. 
     member x.IsExtensionMember = x.IsCSharpStyleExtensionMember || x.IsFSharpStyleExtensionMember
 
@@ -1796,6 +1806,9 @@ type PropInfo =
         | Some vref -> vref.IsDefiniteFSharpOverrideMember
         | None -> false
 
+    member x.ImplementedSlotSignatures =
+        x.ArbitraryValRef.Value.ImplementedSlotSignatures  
+
     member x.IsFSharpExplicitInterfaceImplementation = 
         match x.ArbitraryValRef with 
         | Some vref -> vref.IsFSharpExplicitInterfaceImplementation x.TcGlobals

src/fsharp/vs/IncrementalBuild.fs

@@ -1532,7 +1532,11 @@ module internal IncrementalFSharpBuild =
                 errorRecoveryNoRange e
                 mkSimpleAssRef assemblyName, None, None
 
-          let finalAccWithErrors =  { finalAcc with tcErrors = finalAcc.tcErrors @ errorLogger.GetErrors() }
+          let finalAccWithErrors = 
+            { finalAcc with 
+                tcErrors = finalAcc.tcErrors @ errorLogger.GetErrors() 
+                topAttribs = Some topAttrs
+            }
           ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalAccWithErrors
 
         // END OF BUILD TASK FUNCTIONS

src/fsharp/vs/Symbols.fs

@@ -855,6 +855,57 @@ and FSharpDelegateSignature(cenv, info : SlotSig) =
         | Some ty -> FSharpType(cenv,  ty)
     override x.ToString() = "<delegate signature>"
 
+and FSharpAbstractParameter(cenv, info : SlotParam) =
+
+    member __.Name =    
+        let (TSlotParam(name, _, _, _, _, _)) = info
+        name
+
+    member __.Type = FSharpType(cenv, info.Type)
+
+    member __.IsInArg =
+        let (TSlotParam(_, _, isIn, _, _, _)) = info
+        isIn
+
+    member __.IsOutArg =
+        let (TSlotParam(_, _, _, isOut, _, _)) = info
+        isOut
+
+    member __.IsOptionalArg =
+        let (TSlotParam(_, _, _, _, isOptional, _)) = info
+        isOptional
+
+    member __.Attributes =
+        let (TSlotParam(_, _, _, _, _, attribs)) = info
+        attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a)))
+        |> makeReadOnlyCollection
+
+and FSharpAbstractSignature(cenv, info : SlotSig) =
+
+    member __.AbstractArguments = 
+        info.FormalParams
+        |> List.map (List.map (fun p -> FSharpAbstractParameter(cenv, p)) >> makeReadOnlyCollection)
+        |> makeReadOnlyCollection
+
+    member __.AbstractReturnType = 
+        match info.FormalReturnType with
+        | None -> FSharpType(cenv,  cenv.g.unit_ty)
+        | Some ty -> FSharpType(cenv,  ty)
+
+    member __.DeclaringTypeGenericParameters =
+        info.ClassTypars 
+        |> List.map (fun t -> FSharpGenericParameter(cenv, t))
+        |> makeReadOnlyCollection
+        
+    member __.MethodGenericParameters =
+        info.MethodTypars 
+        |> List.map (fun t -> FSharpGenericParameter(cenv, t))
+        |> makeReadOnlyCollection
+
+    member __.Name = info.Name 
+    
+    member __.DeclaringType = FSharpType(cenv, info.ImplementedType)
+
 and FSharpGenericParameterMemberConstraint(cenv, info : TraitConstraintInfo) = 
     let (TTrait(tys,nm,flags,atys,rty,_)) = info 
     member __.MemberSources = 
@@ -1338,6 +1389,17 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
         | M m -> m.IsFSharpExplicitInterfaceImplementation
         | V v -> v.IsFSharpExplicitInterfaceImplementation cenv.g
 
+    member __.ImplementedAbstractSignatures =
+        checkIsResolved()
+        let sigs =
+            match d with
+            | E e -> e.GetAddMethod().ImplementedSlotSignatures
+            | P p -> p.ImplementedSlotSignatures
+            | M m -> m.ImplementedSlotSignatures
+            | V v -> v.ImplementedSlotSignatures
+        sigs |> List.map (fun s -> FSharpAbstractSignature (cenv, s))
+        |> makeReadOnlyCollection
+
     member __.IsImplicitConstructor = 
         if isUnresolved() then false else 
         match fsharpInfo() with 

src/fsharp/vs/Symbols.fsi

@@ -289,6 +289,48 @@ and [<Class>] FSharpDelegateSignature =
     /// Get the return type of the delegate signature
     member DelegateReturnType : FSharpType
 
+/// Represents a parameter in an abstract method of a class or interface
+and [<Class>] FSharpAbstractParameter =
+
+    /// The optional name of the parameter
+    member Name : string option
+    
+    /// The declared or inferred type of the parameter
+    member Type : FSharpType
+
+    /// Indicate this is an in argument
+    member IsInArg : bool
+
+    /// Indicate this is an out argument
+    member IsOutArg : bool
+
+    /// Indicate this is an optional argument
+    member IsOptionalArg : bool
+
+    /// The declared attributes of the parameter 
+    member Attributes : IList<FSharpAttribute>     
+
+/// Represents the signature of an abstract slot of a class or interface 
+and [<Class>] FSharpAbstractSignature =
+
+    /// Get the arguments of the abstract slot
+    member AbstractArguments : IList<IList<FSharpAbstractParameter>>
+
+    /// Get the return type of the abstract slot
+    member AbstractReturnType : FSharpType
+
+    /// Get the generic arguments of the type defining the abstract slot
+    member DeclaringTypeGenericParameters : IList<FSharpGenericParameter>
+        
+    /// Get the generic arguments of the abstract slot
+    member MethodGenericParameters : IList<FSharpGenericParameter>
+
+    /// Get the name of the abstract slot
+    member Name : string
+    
+    /// Get the declaring type of the abstract slot
+    member DeclaringType : FSharpType
+
 /// A subtype of FSharpSymbol that represents a union case as seen by the F# language
 and [<Class>] FSharpUnionCase =
     inherit FSharpSymbol
@@ -617,6 +659,9 @@ and [<Class>] FSharpMemberOrFunctionOrValue =
     /// Indicates if this is an explicit implementation of an interface member
     member IsExplicitInterfaceImplementation : bool
 
+    /// Gets the list of the abstract slot signatures implemented by the member
+    member ImplementedAbstractSignatures : IList<FSharpAbstractSignature>
+
     /// Indicates if this is a member, including extension members?
     member IsMember : bool
 

tests/service/ProjectAnalysisTests.fs

@@ -4502,17 +4502,24 @@ module Project37 =
 
     let fileName1 = Path.ChangeExtension(Path.GetTempFileName(), ".fs")
     let base2 = Path.GetTempFileName()
+    let fileName2 = Path.ChangeExtension(base2, ".fs")
     let dllName = Path.ChangeExtension(base2, ".dll")
     let projFileName = Path.ChangeExtension(base2, ".fsproj")
     let fileSource1 = """
-[<System.AttributeUsage(System.AttributeTargets.Method ||| System.AttributeTargets.Assembly)>]
+namespace AttrTests
+
+[<System.AttributeUsage(System.AttributeTargets.Method ||| System.AttributeTargets.Assembly) >]
 type AttrTestAttribute() =
     inherit System.Attribute()
 
     new (t: System.Type) = AttrTestAttribute()
     new (t: System.Type[]) = AttrTestAttribute()
     new (t: int[]) = AttrTestAttribute()
 
+[<System.AttributeUsage(System.AttributeTargets.Assembly) >]
+type AttrTest2Attribute() =
+    inherit System.Attribute()
+
 type TestUnion = | A of string
 type TestRecord = { B : int }
 
@@ -4534,7 +4541,14 @@ module Test =
 do ()
 """
     File.WriteAllText(fileName1, fileSource1)
-    let fileNames = [fileName1]
+    let fileSource2 = """
+namespace AttrTests
+
+[<assembly: AttrTest2()>]
+do ()
+"""
+    File.WriteAllText(fileName2, fileSource2)
+    let fileNames = [fileName1; fileName2]
     let args = mkProjectCommandLineArgs (dllName, fileNames)
     let options =  checker.GetProjectOptionsFromCommandLineArgs (projFileName, args)
     let wholeProjectResults =
@@ -4581,4 +4595,97 @@ let ``Test project37 typeof and arrays in attribute constructor arguments`` () =
         | _ -> ()
     Project37.wholeProjectResults.AssemblySignature.Attributes
     |> Seq.map (fun a -> a.AttributeType.CompiledName)
-    |> Array.ofSeq |> shouldEqual [| "AttrTestAttribute" |]
+    |> Array.ofSeq |> shouldEqual [| "AttrTestAttribute"; "AttrTest2Attribute" |]
+
+module Project38 =
+    open System.IO
+
+    let fileName1 = Path.ChangeExtension(Path.GetTempFileName(), ".fs")
+    let base2 = Path.GetTempFileName()
+    let dllName = Path.ChangeExtension(base2, ".dll")
+    let projFileName = Path.ChangeExtension(base2, ".fsproj")
+    let fileSource1 = """
+namespace OverrideTests
+
+type I<'X> =
+    abstract Method : unit -> unit
+    abstract Generic : named:'X -> unit
+    abstract Generic<'Y> : 'X * 'Y -> unit
+    abstract Property : int 
+
+[<AbstractClass>]
+type B<'Y>() =
+    abstract Method : unit -> unit
+    abstract Generic : 'Y -> unit
+    abstract Property : int
+    [<CLIEvent>]
+    abstract Event : IEvent<unit>
+
+type A<'XX, 'YY>() =
+    inherit B<'YY>()
+    
+    let ev = Event<unit>()
+
+    override this.Method() = ()
+    override this.Generic (a: 'YY) = ()
+    override this.Property = 0
+    [<CLIEvent>]
+    override this.Event = ev.Publish
+
+    member this.NotOverride() = ()
+
+    interface I<'XX> with
+        member this.Method() = ()
+        member this.Generic (a: 'XX) = ()
+        member this.Generic<'Y> (a: 'XX, b: 'Y) = ()
+        member this.Property = 1
+"""
+    File.WriteAllText(fileName1, fileSource1)
+    let fileNames = [fileName1]
+    let args = mkProjectCommandLineArgs (dllName, fileNames)
+    let options =  checker.GetProjectOptionsFromCommandLineArgs (projFileName, args)
+    let wholeProjectResults =
+        checker.ParseAndCheckProject(options)
+        |> Async.RunSynchronously
+
+[<Test>]
+let ``Test project38 abstract slot information`` () =
+    let printAbstractSignature (s: FSharpAbstractSignature) =
+        let printType (t: FSharpType) = (string t).[5 ..]       
+        let args = 
+            (s.AbstractArguments |> Seq.concat |> Seq.map (fun a -> 
+                (match a.Name with Some n -> n + ":" | _ -> "") + printType a.Type) |> String.concat " * ")
+            |> function "" -> "()" | a -> a
+        let tgen =
+            match s.DeclaringTypeGenericParameters |> Seq.map (fun m -> "'" + m.Name) |> String.concat "," with
+            | "" -> ""
+            | g -> " original generics: <" + g + ">" 
+        let mgen =
+            match s.MethodGenericParameters |> Seq.map (fun m -> "'" + m.Name) |> String.concat "," with
+            | "" -> ""
+            | g -> "<" + g + ">" 
+        "type " + printType s.DeclaringType + tgen + " with member " + s.Name + mgen + " : " + args + " -> " +
+        printType s.AbstractReturnType
+    
+    let a2ent = Project38.wholeProjectResults.AssemblySignature.Entities |> Seq.find (fun e -> e.FullName = "OverrideTests.A`2")
+    a2ent.MembersFunctionsAndValues |> Seq.map (fun m ->
+        m.CompiledName, (m.ImplementedAbstractSignatures |> Seq.map printAbstractSignature |> List.ofSeq) 
+    )
+    |> Array.ofSeq
+    |> shouldEqual 
+        [|
+            ".ctor", []
+            "Generic", ["type OverrideTests.B<'YY> original generics: <'Y> with member Generic : 'Y -> Microsoft.FSharp.Core.unit"]
+            "OverrideTests-I`1-Generic", ["type OverrideTests.I<'XX> original generics: <'X> with member Generic : named:'X -> Microsoft.FSharp.Core.unit"]
+            "OverrideTests-I`1-Generic", ["type OverrideTests.I<'XX> original generics: <'X> with member Generic<'Y> : 'X * 'Y -> Microsoft.FSharp.Core.unit"]
+            "Method", ["type OverrideTests.B<'YY> original generics: <'Y> with member Method : () -> Microsoft.FSharp.Core.unit"]
+            "OverrideTests-I`1-Method", ["type OverrideTests.I<'XX> original generics: <'X> with member Method : () -> Microsoft.FSharp.Core.unit"]
+            "NotOverride", []
+            "add_Event", ["type OverrideTests.B<'YY> original generics: <'Y> with member add_Event : Microsoft.FSharp.Control.Handler<Microsoft.FSharp.Core.unit> -> Microsoft.FSharp.Core.unit"]
+            "get_Event", ["type OverrideTests.B<'YY> with member get_Event : () -> Microsoft.FSharp.Core.unit"]
+            "get_Property", ["type OverrideTests.B<'YY> original generics: <'Y> with member get_Property : () -> Microsoft.FSharp.Core.int"]
+            "OverrideTests-I`1-get_Property", ["type OverrideTests.I<'XX> original generics: <'X> with member get_Property : () -> Microsoft.FSharp.Core.int"]
+            "remove_Event", ["type OverrideTests.B<'YY> original generics: <'Y> with member remove_Event : Microsoft.FSharp.Control.Handler<Microsoft.FSharp.Core.unit> -> Microsoft.FSharp.Core.unit"]
+            "get_Property", ["type OverrideTests.B<'YY> original generics: <'Y> with member get_Property : () -> Microsoft.FSharp.Core.int"]
+            "get_Event", ["type OverrideTests.B<'YY> with member get_Event : () -> Microsoft.FSharp.Core.unit"]
+        |]