use xml doc from signature if non present in impl (#14920)

* use xml doc from signature if non present in impl for DU and DU case

* Implement the docs fallback for RecdField

* format

* implement Modules

* clean up tests

src/Compiler/Checking/SignatureConformance.fs

@@ -166,6 +166,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
         and checkTypeDef (aenv: TypeEquivEnv) (infoReader: InfoReader) (implTycon: Tycon) (sigTycon: Tycon) =
             let m = implTycon.Range
             
+            implTycon.SetOtherXmlDoc(sigTycon.XmlDoc)
+            
             // Propagate defn location information from implementation to signature . 
             sigTycon.SetOtherRange (implTycon.Range, true)
             implTycon.SetOtherRange (sigTycon.Range, false)
@@ -365,7 +367,9 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
             | _ -> 
                 (errorR (err FSComp.SR.ExceptionDefsNotCompatibleExceptionDeclarationsDiffer); false)
 
-        and checkUnionCase aenv infoReader (enclosingTycon: Tycon) implUnionCase sigUnionCase =
+        and checkUnionCase aenv infoReader (enclosingTycon: Tycon) (implUnionCase: UnionCase) (sigUnionCase: UnionCase) =
+            implUnionCase.SetOtherXmlDoc(sigUnionCase.XmlDoc)
+            
             let err f = errorR(UnionCaseNotContained(denv, infoReader, enclosingTycon, implUnionCase, sigUnionCase, f));false
             sigUnionCase.OtherRangeOpt <- Some (implUnionCase.Range, true)
             implUnionCase.OtherRangeOpt <- Some (sigUnionCase.Range, false)
@@ -376,6 +380,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
             else checkAttribs aenv implUnionCase.Attribs sigUnionCase.Attribs (fun attribs -> implUnionCase.Attribs <- attribs)
 
         and checkField aenv infoReader (enclosingTycon: Tycon) implField sigField =
+            implField.SetOtherXmlDoc(sigField.XmlDoc)
+            
             let err f = errorR(FieldNotContained(denv, infoReader, enclosingTycon, implField, sigField, f)); false
             sigField.rfield_other_range <- Some (implField.Range, true)
             implField.rfield_other_range <- Some (sigField.Range, false)
@@ -646,7 +652,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
                              allPairsOk && not someNotOk)
 
 
-        and checkModuleOrNamespace aenv (infoReader: InfoReader) implModRef sigModRef = 
+        and checkModuleOrNamespace aenv (infoReader: InfoReader) implModRef sigModRef =
+            implModRef.SetOtherXmlDoc(sigModRef.XmlDoc)
             // Propagate defn location information from implementation to signature . 
             sigModRef.SetOtherRange (implModRef.Range, true)
             implModRef.Deref.SetOtherRange (sigModRef.Range, false)

src/Compiler/TypedTree/TypedTree.fs

@@ -563,6 +563,9 @@ type EntityOptionalData =
       // MUTABILITY: only for unpickle linkage
       mutable entity_xmldoc: XmlDoc
       
+      /// the signature xml doc for an item in an implementation file.
+      mutable entity_other_xmldoc : XmlDoc option
+      
       /// The XML document signature for this entity
       mutable entity_xmldocsig: string
 
@@ -651,7 +654,8 @@ type Entity =
         { entity_compiled_name = None 
           entity_other_range = None
           entity_kind = TyparKind.Type
-          entity_xmldoc = XmlDoc.Empty 
+          entity_xmldoc = XmlDoc.Empty
+          entity_other_xmldoc = None
           entity_xmldocsig = ""
           entity_tycon_abbrev = None
           entity_tycon_repr_accessibility = TAccess []
@@ -764,6 +768,11 @@ type Entity =
         match x.entity_opt_data with 
         | Some optData -> optData.entity_other_range <- Some m
         | _ -> x.entity_opt_data <- Some { Entity.NewEmptyEntityOptData() with entity_other_range = Some m }
+        
+    member x.SetOtherXmlDoc xmlDoc =
+        match x.entity_opt_data with
+        | Some optData -> optData.entity_other_xmldoc <- Some xmlDoc
+        | _ -> x.entity_opt_data <- Some { Entity.NewEmptyEntityOptData() with entity_other_xmldoc = Some xmlDoc }
 
     /// A unique stamp for this module, namespace or type definition within the context of this compilation. 
     /// Note that because of signatures, there are situations where in a single compilation the "same" 
@@ -787,7 +796,13 @@ type Entity =
         | _ -> 
 #endif
         match x.entity_opt_data with
-        | Some optData -> optData.entity_xmldoc
+        | Some optData ->
+            if not optData.entity_xmldoc.IsEmpty then
+                optData.entity_xmldoc
+            else
+                match optData.entity_other_xmldoc with
+                | Some xmlDoc -> xmlDoc
+                | None -> XmlDoc.Empty
         | _ -> XmlDoc.Empty
 
     /// The XML documentation sig-string of the entity, if any, to use to lookup an .xml doc file. This also acts
@@ -1046,6 +1061,7 @@ type Entity =
                        entity_kind = tg.entity_kind
                        entity_xmldoc = tg.entity_xmldoc
                        entity_xmldocsig = tg.entity_xmldocsig
+                       entity_other_xmldoc = tg.entity_other_xmldoc 
                        entity_tycon_abbrev = tg.entity_tycon_abbrev
                        entity_tycon_repr_accessibility = tg.entity_tycon_repr_accessibility
                        entity_accessibility = tg.entity_accessibility
@@ -1659,7 +1675,10 @@ type UnionCase =
       ReturnType: TType
 
       /// Documentation for the case 
-      XmlDoc: XmlDoc
+      OwnXmlDoc: XmlDoc
+      
+      /// Documentation for the case from signature file
+      mutable OtherXmlDoc: XmlDoc
 
       /// XML documentation signature for the case
       mutable XmlDocSig: string
@@ -1679,7 +1698,14 @@ type UnionCase =
       // MUTABILITY: used when propagating signature attributes into the implementation.
       mutable Attribs: Attribs
     }
-
+    
+    /// Documentation for the case 
+    member uc.XmlDoc: XmlDoc =
+        if not uc.OwnXmlDoc.IsEmpty then
+            uc.OwnXmlDoc
+        else
+            uc.OtherXmlDoc
+      
     /// Get the declaration location of the union case
     member uc.Range = uc.Id.idRange
 
@@ -1695,6 +1721,9 @@ type UnionCase =
         | Some (m, false) -> m
         | _ -> uc.Range 
 
+    member x.SetOtherXmlDoc xmlDoc =
+        x.OtherXmlDoc <- xmlDoc
+    
     /// Get the logical name of the union case
     member uc.LogicalName = uc.Id.idText
 
@@ -1751,6 +1780,9 @@ type RecdField =
 
       /// Documentation for the field 
       rfield_xmldoc: XmlDoc
+      
+      /// Documentation for the field from signature file 
+      mutable rfield_otherxmldoc: XmlDoc
 
       /// XML Documentation signature for the field
       mutable rfield_xmldocsig: string
@@ -1843,7 +1875,14 @@ type RecdField =
     member v.FormalType = v.rfield_type
 
     /// XML Documentation signature for the field
-    member v.XmlDoc = v.rfield_xmldoc
+    member v.XmlDoc =
+        if not v.rfield_xmldoc.IsEmpty then
+            v.rfield_xmldoc
+        else
+            v.rfield_otherxmldoc
+    
+    member v.SetOtherXmlDoc (xmlDoc: XmlDoc) =
+        v.rfield_otherxmldoc <- xmlDoc        
 
     /// Get or set the XML documentation signature for the field
     member v.XmlDocSig
@@ -3491,7 +3530,15 @@ type EntityRef =
     /// then this _does_ include this documentation. If the entity is backed by Abstract IL metadata
     /// or comes from another F# assembly then it does not (because the documentation will get read from 
     /// an XML file).
-    member x.XmlDoc = x.Deref.XmlDoc
+    member x.XmlDoc =
+        if not (x.Deref.XmlDoc.IsEmpty) then
+                x.Deref.XmlDoc
+        else
+            x.Deref.entity_opt_data
+            |> Option.bind (fun d -> d.entity_other_xmldoc)
+            |> Option.defaultValue XmlDoc.Empty
+    
+    member x.SetOtherXmlDoc (xmlDoc: XmlDoc) = x.Deref.SetOtherXmlDoc(xmlDoc)
 
     /// The XML documentation sig-string of the entity, if any, to use to lookup an .xml doc file. This also acts
     /// as a cache for this sig-string computation.
@@ -5844,7 +5891,8 @@ type Construct() =
     /// Create a new union case node
     static member NewUnionCase id tys retTy attribs docOption access: UnionCase = 
         { Id = id
-          XmlDoc = docOption
+          OwnXmlDoc = docOption
+          OtherXmlDoc = XmlDoc.Empty
           XmlDocSig = ""
           Accessibility = access
           FieldTable = Construct.MakeRecdFieldsTable tys
@@ -5883,7 +5931,8 @@ type Construct() =
           rfield_const = konst
           rfield_access = access
           rfield_secret = secret
-          rfield_xmldoc = docOption 
+          rfield_xmldoc = docOption
+          rfield_otherxmldoc = XmlDoc.Empty
           rfield_xmldocsig = ""
           rfield_id = id
           rfield_name_generated = nameGenerated

src/Compiler/TypedTree/TypedTree.fsi

@@ -353,6 +353,9 @@ type EntityOptionalData =
         /// The declared documentation for the type or module
         mutable entity_xmldoc: XmlDoc
 
+        /// the signature xml doc for an item in an implementation file.
+        mutable entity_other_xmldoc: XmlDoc option
+
         /// The XML document signature for this entity
         mutable entity_xmldocsig: string
 
@@ -460,6 +463,8 @@ type Entity =
 
     member SetOtherRange: m: (range * bool) -> unit
 
+    member SetOtherXmlDoc: xmlDoc: XmlDoc -> unit
+
     member SetTypeAbbrev: tycon_abbrev: TType option -> unit
 
     member SetTypeOrMeasureKind: kind: TyparKind -> unit
@@ -1114,7 +1119,10 @@ type UnionCase =
         ReturnType: TType
 
         /// Documentation for the case
-        XmlDoc: XmlDoc
+        OwnXmlDoc: XmlDoc
+
+        /// Documentation for the case from signature file
+        mutable OtherXmlDoc: XmlDoc
 
         /// XML documentation signature for the case
         mutable XmlDocSig: string
@@ -1133,6 +1141,8 @@ type UnionCase =
         mutable Attribs: Attribs
     }
 
+    member XmlDoc: XmlDoc
+
     /// Get a field of the union case by position
     member GetFieldByIndex: n: int -> RecdField
 
@@ -1184,6 +1194,8 @@ type UnionCase =
     /// Get the signature location of the union case
     member SigRange: range
 
+    member SetOtherXmlDoc: xmlDoc: XmlDoc -> unit
+
 /// Represents a class, struct, record or exception field in an F# type, exception or union-case definition.
 /// This may represent a "field" in either a struct, class, record or union.
 [<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
@@ -1196,6 +1208,9 @@ type RecdField =
         /// Documentation for the field
         rfield_xmldoc: XmlDoc
 
+        /// Documentation for the field from signature file
+        mutable rfield_otherxmldoc: XmlDoc
+
         /// XML Documentation signature for the field
         mutable rfield_xmldocsig: string
 
@@ -1294,6 +1309,8 @@ type RecdField =
     /// Get or set the XML documentation signature for the field
     member XmlDocSig: string with get, set
 
+    member SetOtherXmlDoc: xmlDoc: XmlDoc -> unit
+
 /// Represents the implementation of an F# exception definition.
 [<NoEquality; NoComparison>]
 type ExceptionInfo =
@@ -2640,6 +2657,8 @@ type EntityRef =
     /// an XML file).
     member XmlDoc: XmlDoc
 
+    member SetOtherXmlDoc: XmlDoc -> unit
+
     /// The XML documentation sig-string of the entity, if any, to use to lookup an .xml doc file. This also acts
     /// as a cache for this sig-string computation.
     member XmlDocSig: string

src/Compiler/TypedTree/TypedTreePickle.fs

@@ -2046,7 +2046,8 @@ and u_unioncase_spec st =
       ReturnType=b
       Id=d
       Attribs=e
-      XmlDoc= defaultArg xmldoc XmlDoc.Empty
+      OwnXmlDoc= defaultArg xmldoc XmlDoc.Empty
+      OtherXmlDoc = XmlDoc.Empty 
       XmlDocSig=f
       Accessibility=i
       OtherRangeOpt=None }
@@ -2088,6 +2089,7 @@ and u_recdfield_spec st =
       rfield_pattribs=e1
       rfield_fattribs=e2
       rfield_xmldoc= defaultArg xmldoc XmlDoc.Empty
+      rfield_otherxmldoc = XmlDoc.Empty 
       rfield_xmldocsig=f
       rfield_access=g
       rfield_name_generated = d.idRange.IsSynthetic

tests/FSharp.Compiler.Service.Tests/TooltipTests.fs

@@ -10,27 +10,15 @@ open FSharp.Compiler.EditorServices
 open FSharp.Compiler.Symbols
 open NUnit.Framework
 
-[<Test>]
-let ``Display XML doc of signature file if implementation doesn't have one`` () =
+let testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource line colAtEndOfNames lineText names (expectedContent: string) =
     let files =
         Map.ofArray
             [| "A.fsi",
-               SourceText.ofString
-                   """
-module Foo
+               SourceText.ofString sigSource
 
-/// Great XML doc comment
-val bar: a: int -> b: int -> int
-"""
 
                "A.fs",
-               SourceText.ofString
-                   """
-module Foo
-
-// No XML doc here because the signature file has one right?
-let bar a b = a - b
-""" |]
+               SourceText.ofString implSource |]
 
     let documentSource fileName = Map.tryFind fileName files
 
@@ -49,25 +37,230 @@ let bar a b = a - b
 
     match checkResult with
     | _, FSharpCheckFileAnswer.Succeeded(checkResults) ->
-        let barSymbol = findSymbolByName "bar" checkResults
-
-        match barSymbol with
-        | :? FSharpMemberOrFunctionOrValue as mfv -> Assert.True mfv.HasSignatureFile
-        | _ -> Assert.Fail "Expected to find a symbol FSharpMemberOrFunctionOrValue that HasSignatureFile"
-
-        // Get the tooltip for `bar` in the implementation file
+        // Get the tooltip for (line, colAtEndOfNames) in the implementation file
         let (ToolTipText tooltipElements) =
-            checkResults.GetToolTip(4, 4, "let bar a b = a - b", [ "bar" ], FSharpTokenTag.Identifier)
+            checkResults.GetToolTip(line, colAtEndOfNames, lineText, names, FSharpTokenTag.Identifier)
 
         match tooltipElements with
-        | [ ToolTipElement.Group [ element ] ] ->
+        | ToolTipElement.Group [ element ] :: _ ->
             match element.XmlDoc with
-            | FSharpXmlDoc.FromXmlText xmlDoc -> Assert.True xmlDoc.NonEmpty
+            | FSharpXmlDoc.FromXmlText xmlDoc ->
+                Assert.True xmlDoc.NonEmpty
+                Assert.True (xmlDoc.UnprocessedLines[0].Contains(expectedContent))
             | xmlDoc -> Assert.Fail $"Expected FSharpXmlDoc.FromXmlText, got {xmlDoc}"
-        | elements -> Assert.Fail $"Expected a single tooltip group element, got {elements}"
+        | elements -> Assert.Fail $"Expected at least one tooltip group element, got {elements}"
     | _ -> Assert.Fail "Expected checking to succeed."
+
     
+[<Test>]
+let ``Display XML doc of signature file for let if implementation doesn't have one`` () =
+    let sigSource =
+        """
+module Foo
+
+/// Great XML doc comment
+val bar: a: int -> b: int -> int
+"""
+
+    let implSource =
+                   """
+module Foo
+
+// No XML doc here because the signature file has one right?
+let bar a b = a - b
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 4 4 "let bar a b = a - b" [ "bar" ] "Great XML doc comment"
     
+
+[<Test>]
+let ``Display XML doc of signature file for partial AP if implementation doesn't have one`` () =
+    let sigSource =
+        """
+module Foo
+
+/// Some Sig Doc on IsThree
+val (|IsThree|_|): x: int -> int option
+"""
+
+    let implSource =
+        """
+module Foo
+
+// No XML doc here because the signature file has one right?
+let (|IsThree|_|) x = if x = 3 then Some x else None
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 4 4 "let (|IsThree|_|) x = if x = 3 then Some x else None" [ "IsThree" ] "Some Sig Doc on IsThree"
+    
+
+[<Test>]
+let ``Display XML doc of signature file for DU if implementation doesn't have one`` () =
+    let sigSource =
+        """
+module Foo
+
+/// Some sig comment on the disc union type
+type Bar =
+    | Case1 of int * string
+    | Case2 of string
+"""
+               
+    let implSource =
+        """
+module Foo
+
+// No XML doc here because the signature file has one right?
+type Bar =
+    | Case1 of int * string
+    | Case2 of string
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 4 7 "type Bar =" [ "Bar" ] "Some sig comment on the disc union type"
+
+
+[<Test>]
+let ``Display XML doc of signature file for DU case if implementation doesn't have one`` () =
+    let sigSource =
+        """
+module Foo
+
+type Bar =
+    | BarCase1 of int * string
+    /// Some sig comment on the disc union case
+    | BarCase2 of string
+"""
+
+    let implSource =
+        """
+module Foo
+
+type Bar =
+    | BarCase1 of int * string
+    // No XML doc here because the signature file has one right?
+    | BarCase2 of string
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 7 14 "    | BarCase2 of string" [ "BarCase2" ] "Some sig comment on the disc union case"
+
+
+[<Test>]
+let ``Display XML doc of signature file for record type if implementation doesn't have one`` () =
+    let sigSource =
+        """
+module Foo
+
+/// Some sig comment on record type
+type Bar = {
+    SomeField: int
+}
+"""
+
+    let implSource =
+        """
+module Foo
+
+type Bar = {
+    SomeField: int
+}
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 3 9 "type Bar = {" [ "Bar" ] "Some sig comment on record type"
+
+
+[<Test>]
+let ``Display XML doc of signature file for record field if implementation doesn't have one`` () =
+    let sigSource =
+        """
+module Foo
+
+type Bar = {
+    /// Some sig comment on record field
+    SomeField: int
+}
+"""
+
+    let implSource =
+        """
+module Foo
+
+type Bar = {
+    SomeField: int
+}
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 5 9 "    SomeField: int" [ "SomeField" ] "Some sig comment on record field"
+
+
+[<Test>]
+let ``Display XML doc of signature file for class type if implementation doesn't have one`` () =
+    let sigSource =
+        """
+module Foo
+
+/// Some sig comment on class type
+type Bar =
+    new: unit -> Bar
+    member Foo: string
+"""
+               
+    let implSource =
+        """
+module Foo
+
+type Bar() =
+    member val Foo = "bla" with get, set
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 3 9 "type Bar() =" [ "Bar" ] "Some sig comment on class type"
+
+
+[<Test>]
+let ``Display XML doc of signature file for class member if implementation doesn't have one`` () =
+    let sigSource =
+        """
+module Foo
+
+type Bar =
+    new: unit -> Bar
+    /// Some sig comment on auto property
+    member Foo: string
+    /// Some sig comment on class member
+    member Func: int -> int -> int
+"""
+
+    let implSource =
+        """
+module Foo
+
+type Bar() =
+    member val Foo = "bla" with get, set
+    member _.Func x y = x * y
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 6 30 "    member _.Func x y = x * y" [ "_"; "Func" ] "Some sig comment on class member"
+
+
+[<Test>]
+let ``Display XML doc of signature file for module if implementation doesn't have one`` () =
+    let sigSource =
+        """
+/// Some sig comment on module
+module Foo
+
+val a: int
+"""
+               
+    let implSource =
+        """
+module Foo
+
+let a = 23
+"""
+
+    testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource 2 10 "module Foo" [ "Foo" ] "Some sig comment on module"
+
+
 let testToolTipSquashing source line colAtEndOfNames lineText names tokenTag =
     let files =
         Map.ofArray