diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index cf2d2a0bc13..7ef065dff27 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/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) diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index af37bf45c92..3bfe81677ea 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/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 diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 8cee5e349f7..3105d4e078e 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/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. [] @@ -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. [] 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 diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 818d36ecc9c..2e14d3ca3be 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/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 diff --git a/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs b/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs index 2a28d74a15b..b76d402c83d 100644 --- a/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs @@ -10,27 +10,15 @@ open FSharp.Compiler.EditorServices open FSharp.Compiler.Symbols open NUnit.Framework -[] -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." + +[] +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" + +[] +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" + + +[] +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" + + +[] +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" + + +[] +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" + + +[] +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" + + +[] +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" + + +[] +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" + + +[] +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