Check FSharp.Core xml doc comments for validity

src/fsharp/CompileOps.fs

@@ -404,6 +404,7 @@ let warningOn err level specificWarnOn =
     | 1182 -> false // chkUnusedValue - off by default
     | 3218 -> false // ArgumentsInSigAndImplMismatch - off by default
     | 3180 -> false // abImplicitHeapAllocation - off by default
+    | 3390 -> false // xmlDocBadlyFormed - off by default
     | _ -> level >= GetWarningLevel err 
 
 let SplitRelatedDiagnostics(err: PhasedDiagnostic) : PhasedDiagnostic * PhasedDiagnostic list = 

src/fsharp/FSComp.txt

@@ -1540,3 +1540,6 @@ forFormatInvalidForInterpolated4,"Interpolated strings used as type IFormattable
 3382,parsEmptyFillInInterpolatedString,"Invalid interpolated string. This interpolated string expression fill is empty, an expression was expected."
 3383,lexRBraceInInterpolatedString,"A '}}' character must be escaped (by doubling) in an interpolated string."
 #3501   "This construct is not supported by your version of the F# compiler" CompilerMessage(ExperimentalAttributeMessages.NotSupportedYet, 3501, IsError=true)
+3390,xmlDocBadlyFormed,"This XML comment is invalid: '%s'"
+3390,xmlDocMissingParameterName,"This XML comment is invalid: missing parameter name"
+3390,xmlDocInvalidParameterName,"This XML comment is invalid: invalid parameter reference '%s'"

src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj

@@ -21,7 +21,7 @@
     <NuspecFile>FSharp.Compiler.Service.nuspec</NuspecFile>
     <IsPackable Condition="'$(OS)' != 'Unix'">true</IsPackable>
     <PackageDescription>The F# Compiler Services package For F# $(FSLanguageVersion) exposes additional functionality for implementing F# language bindings, additional tools based on the compiler or refactoring tools. The package also includes F# interactive service that can be used for embedding F# scripting into your applications.  Contains code from the F# Software Foundation.</PackageDescription>
-    <PackageReleaseNotes>/blob/main/release-notes.md#FSharp-Compilere-Service-$(FSharpCompilerServiceReleaseNotesVersion)</PackageReleaseNotes>
+    <PackageReleaseNotes>/blob/main/release-notes.md#FSharp-Compiler-Service-$(FSharpCompilerServiceReleaseNotesVersion)</PackageReleaseNotes>
     <PackageTags>F#, fsharp, interactive, compiler, editor</PackageTags>
   </PropertyGroup>
 

src/fsharp/FSharp.Core/FSharp.Core.fsproj

@@ -9,7 +9,7 @@
     <AllowCrossTargeting>true</AllowCrossTargeting>
     <DefineConstants>$(DefineConstants);FSHARP_CORE</DefineConstants>
     <DefineConstants Condition="'$(Configuration)' == 'Proto'">BUILDING_WITH_LKG;$(DefineConstants)</DefineConstants>
-    <OtherFlags>$(OtherFlags) --warnon:1182 --compiling-fslib --compiling-fslib-40 --maxerrors:20 --extraoptimizationloops:1 --nowarn:57</OtherFlags>
+    <OtherFlags>$(OtherFlags) --warnon:1182 --warnon:3390 --compiling-fslib --compiling-fslib-40 --maxerrors:20 --extraoptimizationloops:1 --nowarn:57</OtherFlags>
     <Tailcalls>true</Tailcalls> <!-- .tail annotations always emitted for this binary, even in debug mode -->
     <NGenBinary>true</NGenBinary>
 

src/fsharp/FSharp.Core/prim-types.fs

@@ -370,7 +370,7 @@ namespace Microsoft.FSharp.Core
     [<MeasureAnnotatedAbbreviation>] type int16<[<Measure>] 'Measure> = int16
     [<MeasureAnnotatedAbbreviation>] type int64<[<Measure>] 'Measure> = int64
 
-    /// <summary>Represents a managed pointer in F# code.</c></summary>
+    /// <summary>Represents a managed pointer in F# code.</summary>
     type byref<'T> = (# "!0&" #)
 
     /// <summary>Represents a managed pointer in F# code.</summary>

src/fsharp/ParseHelpers.fs

@@ -85,7 +85,7 @@ module LexbufLocalXmlDocStore =
         lexbuf.BufferLocalStore.[xmlDocKey] <- box (XmlDocCollector())
 
     /// Called from the lexer to save a single line of XML doc comment.
-    let internal SaveXmlDocLine (lexbuf: Lexbuf, lineText, pos) =
+    let internal SaveXmlDocLine (lexbuf: Lexbuf, lineText, range: range) =
         let collector =
             match lexbuf.BufferLocalStore.TryGetValue xmlDocKey with
             | true, collector -> collector
@@ -94,7 +94,7 @@ module LexbufLocalXmlDocStore =
                 lexbuf.BufferLocalStore.[xmlDocKey] <- collector
                 collector
         let collector = unbox<XmlDocCollector>(collector)
-        collector.AddXmlDocLine(lineText, pos)
+        collector.AddXmlDocLine(lineText, range)
 
     /// Called from the parser each time we parse a construct that marks the end of an XML doc comment range,
     /// e.g. a 'type' declaration. The markerRange is the range of the keyword that delimits the construct.

src/fsharp/TypedTree.fs

@@ -745,7 +745,9 @@ type Entity =
     member x.XmlDoc = 
 #if !NO_EXTENSIONTYPING
         match x.TypeReprInfo with
-        | TProvidedTypeExtensionPoint info -> XmlDoc (info.ProvidedType.PUntaintNoFailure(fun st -> (st :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(info.ProvidedType.TypeProvider.PUntaintNoFailure id)))
+        | TProvidedTypeExtensionPoint info ->
+            let lines = info.ProvidedType.PUntaintNoFailure(fun st -> (st :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(info.ProvidedType.TypeProvider.PUntaintNoFailure id))
+            XmlDoc (lines |> Array.map (fun line -> line, x.DefinitionRange))
         | _ -> 
 #endif
         match x.entity_opt_data with

src/fsharp/TypedTreePickle.fs

@@ -1345,15 +1345,15 @@ let p_range (x: range) st =
 
 let p_dummy_range : range pickler   = fun _x _st -> ()
 let p_ident (x: Ident) st = p_tup2 p_string p_range (x.idText, x.idRange) st
-let p_xmldoc (XmlDoc x) st = p_array p_string x st
+let p_xmldoc (XmlDoc lines) st = p_array p_string (Array.map fst lines) st
 
 let u_pos st = let a = u_int st in let b = u_int st in mkPos a b
 let u_range st = let a = u_string st in let b = u_pos st in let c = u_pos st in mkRange a b c
 
 // Most ranges (e.g. on optimization expressions) can be elided from stored data
 let u_dummy_range : range unpickler = fun _st -> range0
 let u_ident st = let a = u_string st in let b = u_range st in ident(a, b)
-let u_xmldoc st = XmlDoc (u_array u_string st)
+let u_xmldoc st = XmlDoc (u_array u_string st |> Array.map (fun line -> line, range0))
 
 let p_local_item_ref ctxt tab st = p_osgn_ref ctxt tab st
 

src/fsharp/XmlDoc.fs

@@ -2,37 +2,61 @@
 
 module public FSharp.Compiler.XmlDoc
 
+open System
+open System.Xml.Linq
+open FSharp.Compiler.ErrorLogger
+open FSharp.Compiler.Lib
 open FSharp.Compiler.AbstractIL.Internal.Library
 open FSharp.Compiler.Range
 
-/// Represents the final form of collected XmlDoc lines
+/// Represents collected XmlDoc lines
 type XmlDoc =
-    | XmlDoc of string[]
+    | XmlDoc of (string * range)[]
 
     static member Empty = XmlDocStatics.Empty
 
-    member x.NonEmpty = (let (XmlDoc lines) = x in lines.Length <> 0)
+    member x.IsEmpty =
+        let (XmlDoc lines) = x
+        lines |> Array.forall (fst >> String.IsNullOrWhiteSpace)
+
+    member x.NonEmpty = not x.IsEmpty
 
-    static member Merge (XmlDoc lines) (XmlDoc lines') = XmlDoc (Array.append lines lines')
+    static member Merge (XmlDoc lines) (XmlDoc lines') = 
+        XmlDoc (Array.append lines lines')
 
+    member x.Range = 
+        let (XmlDoc lines) = x
+        match lines with 
+        | [| |] -> Range.range0
+        | _ -> Array.reduce Range.unionRanges (Array.map snd lines)
+
     /// This code runs for .XML generation and thus influences cross-project xmldoc tooltips; for within-project tooltips,
     /// see XmlDocumentation.fs in the language service
     static member Process (XmlDoc lines) =
-        let rec processLines (lines: string list) =
+        let rec processLines (lines: (string * range) list) =
             match lines with
             | [] -> []
-            | (lineA :: rest) as lines ->
+            | ((lineA, m) :: rest) as lines ->
                 let lineAT = lineA.TrimStart([|' '|])
                 if lineAT = "" then processLines rest
                 else if lineAT.StartsWithOrdinal("<") then lines
-                else ["<summary>"] @
-                     (lines |> List.map (fun line -> Microsoft.FSharp.Core.XmlAdapters.escape line)) @
-                     ["</summary>"]
+                else [("<summary>", m)] @
+                     (lines |> List.map (map1Of2 Microsoft.FSharp.Core.XmlAdapters.escape)) @
+                     [("</summary>", m)]
 
         let lines = processLines (Array.toList lines)
         if isNil lines then XmlDoc.Empty
         else XmlDoc (Array.ofList lines)
 
+    member x.GetXmlText() =
+        match XmlDoc.Process x with
+        | XmlDoc [| |] -> ""
+        | XmlDoc strs ->
+            strs 
+            |> Array.toList
+            |> List.map fst
+            |> String.concat Environment.NewLine
+
 // Discriminated unions can't contain statics, so we use a separate type
 and XmlDocStatics() =
 
@@ -42,14 +66,14 @@ and XmlDocStatics() =
 
 /// Used to collect XML documentation during lexing and parsing.
 type XmlDocCollector() =
-    let mutable savedLines = new ResizeArray<(string * pos)>()
+    let mutable savedLines = new ResizeArray<(string * range)>()
     let mutable savedGrabPoints = new ResizeArray<pos>()
     let posCompare p1 p2 = if posGeq p1 p2 then 1 else if posEq p1 p2 then 0 else -1
     let savedGrabPointsAsArray =
         lazy (savedGrabPoints.ToArray() |> Array.sortWith posCompare)
 
     let savedLinesAsArray =
-        lazy (savedLines.ToArray() |> Array.sortWith (fun (_, p1) (_, p2) -> posCompare p1 p2))
+        lazy (savedLines.ToArray() |> Array.sortWith (fun (_, p1) (_, p2) -> posCompare p1.End p2.End))
 
     let check() =
         // can't add more XmlDoc elements to XmlDocCollector after extracting first XmlDoc from the overall results
@@ -59,26 +83,26 @@ type XmlDocCollector() =
         check()
         savedGrabPoints.Add pos
 
-    member x.AddXmlDocLine(line, pos) =
+    member x.AddXmlDocLine(line, range) =
         check()
-        savedLines.Add(line, pos)
+        savedLines.Add(line, range)
 
     member x.LinesBefore grabPointPos =
       try
         let lines = savedLinesAsArray.Force()
         let grabPoints = savedGrabPointsAsArray.Force()
-        let firstLineIndexAfterGrabPoint = Array.findFirstIndexWhereTrue lines (fun (_, pos) -> posGeq pos grabPointPos)
+        let firstLineIndexAfterGrabPoint = Array.findFirstIndexWhereTrue lines (fun (_, m) -> posGeq m.End grabPointPos)
         let grabPointIndex = Array.findFirstIndexWhereTrue grabPoints (fun pos -> posGeq pos grabPointPos)
         assert (posEq grabPoints.[grabPointIndex] grabPointPos)
         let firstLineIndexAfterPrevGrabPoint =
             if grabPointIndex = 0 then
                 0
             else
                 let prevGrabPointPos = grabPoints.[grabPointIndex-1]
-                Array.findFirstIndexWhereTrue lines (fun (_, pos) -> posGeq pos prevGrabPointPos)
+                Array.findFirstIndexWhereTrue lines (fun (_, m) -> posGeq m.End prevGrabPointPos)
 
         let lines = lines.[firstLineIndexAfterPrevGrabPoint..firstLineIndexAfterGrabPoint-1]
-        lines |> Array.map fst
+        lines
       with e ->
         [| |]
 
@@ -89,13 +113,42 @@ type PreXmlDoc =
     | PreXmlDocEmpty
 
     member x.ToXmlDoc() =
-        match x with
-        | PreXmlMerge(a, b) -> XmlDoc.Merge (a.ToXmlDoc()) (b.ToXmlDoc())
-        | PreXmlDocEmpty -> XmlDoc.Empty
-        | PreXmlDoc (pos, collector) ->
-            let lines = collector.LinesBefore pos
-            if lines.Length = 0 then XmlDoc.Empty
-            else XmlDoc lines
+        let doc =
+            match x with
+            | PreXmlMerge(a, b) -> XmlDoc.Merge (a.ToXmlDoc()) (b.ToXmlDoc())
+            | PreXmlDocEmpty -> XmlDoc.Empty
+            | PreXmlDoc (pos, collector) ->
+                let lines = collector.LinesBefore pos
+                if lines.Length = 0 then XmlDoc.Empty
+                else XmlDoc lines
+        if doc.NonEmpty then
+            try
+                // We must wrap with <doc> in order to have only one root element
+                let xml = XDocument.Parse("<doc>\n"+doc.GetXmlText()+"\n</doc>", LoadOptions.SetLineInfo)
+
+                // Note, the parameter names are curently only checked for internal
+                // consistency, so parameter references must match an XML doc parameter name.
+                let paramNames =
+                    [ for p in xml.Descendants(XName.op_Implicit "param") do
+                        match p.Attribute(XName.op_Implicit "name") with 
+                        | null -> 
+                            warning (Error (FSComp.SR.xmlDocMissingParameterName(), doc.Range))
+                        | nm -> 
+                            nm.Value ]
+
+                for pref in xml.Descendants(XName.op_Implicit "paramref") do
+                    match pref.Attribute(XName.op_Implicit "name") with 
+                    | null -> warning (Error (FSComp.SR.xmlDocMissingParameterName(), doc.Range))
+                    | attr -> 
+                       let nm = attr.Value
+                       if not (paramNames |> List.contains nm) then
+                          warning (Error (FSComp.SR.xmlDocInvalidParameterName(nm), doc.Range))
+                xml |> ignore
+
+            with e -> 
+                warning (Error (FSComp.SR.xmlDocBadlyFormed(e.Message), doc.Range))
+        doc
+
 
     static member CreateFromGrabPoint(collector: XmlDocCollector, grabPointPos) =
         collector.AddGrabPoint grabPointPos

src/fsharp/fsc.fs

@@ -328,11 +328,6 @@ module InterfaceFileWriter =
 
 module XmlDocWriter =
 
-    let getDoc xmlDoc = 
-        match XmlDoc.Process xmlDoc with
-        | XmlDoc [| |] -> ""
-        | XmlDoc strs  -> strs |> Array.toList |> String.concat Environment.NewLine
-
     let hasDoc xmlDoc =
         // No need to process the xml doc - just need to know if there's anything there
         match xmlDoc with
@@ -389,7 +384,7 @@ module XmlDocWriter =
         let mutable members = []
         let addMember id xmlDoc = 
             if hasDoc xmlDoc then
-                let doc = getDoc xmlDoc
+                let doc = xmlDoc.GetXmlText()
                 members <- (id, doc) :: members
         let doVal (v: Val) = addMember v.XmlDocSig v.XmlDoc
         let doUnionCase (uc: UnionCase) = addMember uc.XmlDocSig uc.XmlDoc

src/fsharp/infos.fs

@@ -1064,7 +1064,9 @@ type MethInfo =
         | DefaultStructCtor _ -> XmlDoc.Empty
 #if !NO_EXTENSIONTYPING
         | ProvidedMeth(_, mi, _, m)->
-            XmlDoc (mi.PUntaint((fun mix -> (mix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(mi.TypeProvider.PUntaintNoFailure id)), m))
+            let lines = mi.PUntaint((fun mix -> (mix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(mi.TypeProvider.PUntaintNoFailure id)), m)
+            let lines = lines |> Array.map (fun line -> line, m)
+            XmlDoc lines
 #endif
 
     /// Try to get an arbitrary F# ValRef associated with the member. This is to determine if the member is virtual, amongst other things.
@@ -2162,7 +2164,9 @@ type PropInfo =
         | FSProp(_, _, None, None) -> failwith "unreachable"
 #if !NO_EXTENSIONTYPING
         | ProvidedProp(_, pi, m) ->
-            XmlDoc (pi.PUntaint((fun pix -> (pix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(pi.TypeProvider.PUntaintNoFailure id)), m))
+            let lines = pi.PUntaint((fun pix -> (pix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(pi.TypeProvider.PUntaintNoFailure id)), m)
+            let lines = lines |> Array.map (fun line -> line, m)
+            XmlDoc lines
 #endif
 
     /// Get the TcGlobals associated with the object
@@ -2416,7 +2420,9 @@ type EventInfo =
         | FSEvent (_, p, _, _) -> p.XmlDoc
 #if !NO_EXTENSIONTYPING
         | ProvidedEvent (_, ei, m) ->
-            XmlDoc (ei.PUntaint((fun eix -> (eix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(ei.TypeProvider.PUntaintNoFailure id)), m))
+            let lines = ei.PUntaint((fun eix -> (eix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(ei.TypeProvider.PUntaintNoFailure id)), m)
+            let lines = lines |> Array.map (fun line -> line, m)
+            XmlDoc lines
 #endif
 
     /// Get the logical name of the event.

src/fsharp/lex.fsl

@@ -166,15 +166,17 @@ let startString args (lexbuf: UnicodeLexing.Lexbuf) =
 
 // Utility functions for processing XML documentation 
 
-let trySaveXmlDoc lexbuf (buff:option<System.Text.StringBuilder>) =
+let trySaveXmlDoc (lexbuf: LexBuffer<char>) (buff: (range * StringBuilder) option) =
     match buff with 
     | None -> () 
-    | Some sb -> LexbufLocalXmlDocStore.SaveXmlDocLine (lexbuf, sb.ToString(), posOfLexPosition lexbuf.StartPos)
+    | Some (start, sb) ->
+        let xmlCommentLineRange = mkFileIndexRange start.FileIndex start.Start (posOfLexPosition lexbuf.StartPos)
+        LexbufLocalXmlDocStore.SaveXmlDocLine (lexbuf, sb.ToString(), xmlCommentLineRange)
 
-let tryAppendXmlDoc (buff:option<System.Text.StringBuilder>) (s:string) =
+let tryAppendXmlDoc (buff: (range * StringBuilder) option) (s:string) =
     match buff with 
     | None -> ()
-    | Some sb -> ignore(sb.Append s)
+    | Some (_, sb) -> ignore(sb.Append s)
 
 // Utilities for parsing #if/#else/#endif 
 
@@ -660,7 +662,7 @@ rule token args skip = parse
        let doc = lexemeTrimLeft lexbuf 3  
        let sb = (new StringBuilder(100)).Append(doc)
        if not skip then LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, 1, m)) 
-       else singleLineComment (Some sb,1,m,args) skip lexbuf }
+       else singleLineComment (Some (m, sb),1,m,args) skip lexbuf }
 
  | "//" op_char*
      { // Need to read all operator symbols too, otherwise it might be parsed by a rule below 

src/fsharp/service/ServiceXmlDocParser.fs

@@ -49,12 +49,10 @@ module XmlDocParsing =
             i
 
         let isEmptyXmlDoc (preXmlDoc: PreXmlDoc) =
-            match preXmlDoc.ToXmlDoc() with 
-            | XmlDoc [||] -> true
-            | XmlDoc [|x|] when x.Trim() = "" -> true
-            | _ -> false
+            preXmlDoc.ToXmlDoc().IsEmpty
 
-        let rec getXmlDocablesSynModuleDecl = function
+        let rec getXmlDocablesSynModuleDecl decl =
+            match decl with 
             | SynModuleDecl.NestedModule(_,  _, synModuleDecls, _, _) -> 
                 (synModuleDecls |> List.collect getXmlDocablesSynModuleDecl)
             | SynModuleDecl.Let(_, synBindingList, range) -> 

src/fsharp/symbols/SymbolHelpers.fs

@@ -662,13 +662,14 @@ module internal SymbolHelpers =
     let GetXmlCommentForItemAux (xmlDoc: XmlDoc option) (infoReader: InfoReader) m d = 
         let result = 
             match xmlDoc with 
-            | None | Some (XmlDoc [| |]) -> ""
-            | Some (XmlDoc l) -> 
+            | None -> ""
+            | Some xmlDoc when xmlDoc.IsEmpty -> ""
+            | Some (XmlDoc lines) -> 
                 bufs (fun os -> 
                     bprintf os "\n"
-                    l |> Array.iter (fun (s: string) -> 
+                    lines |> Array.iter (fun (line, _) -> 
                         // Note: this code runs for local/within-project xmldoc tooltips, but not for cross-project or .XML
-                        bprintf os "\n%s" s))
+                        bprintf os "\n%s" line))
 
         if String.IsNullOrEmpty result then 
             GetXmlDocHelpSigOfItemForLookup infoReader m d

src/fsharp/symbols/Symbols.fs

@@ -78,7 +78,8 @@ module Impl =
     let makeReadOnlyCollection (arr: seq<'T>) = 
         System.Collections.ObjectModel.ReadOnlyCollection<_>(Seq.toArray arr) :> IList<_>
 
-    let makeXmlDoc (XmlDoc x) = makeReadOnlyCollection x
+    let makeXmlDoc (XmlDoc lines) =
+        makeReadOnlyCollection (Array.map fst lines)
 
     let rescopeEntity optViewedCcu (entity: Entity) = 
         match optViewedCcu with