diff --git a/docs/release-notes/.FSharp.Compiler.Service/10.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/10.0.200.md index 6402c991f59..6853abe6695 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/10.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/10.0.200.md @@ -11,6 +11,7 @@ ### Added * FSharpDiagnostic: add default severity ([#19152](https://github.com/dotnet/fsharp/pull/19152)) +* Support for `` XML documentation tag ([PR #19186](https://github.com/dotnet/fsharp/pull/19186)) * Add warning FS3879 for XML documentation comments not positioned as first non-whitespace on line. ([PR #18891](https://github.com/dotnet/fsharp/pull/18891)) * FsiEvaluationSession.ParseAndCheckInteraction: add keepAssemblyContents optional parameter ([#19155](https://github.com/dotnet/fsharp/pull/19155)) diff --git a/src/Compiler/Driver/XmlDocFileWriter.fs b/src/Compiler/Driver/XmlDocFileWriter.fs index 004293087bf..a575d8beefe 100644 --- a/src/Compiler/Driver/XmlDocFileWriter.fs +++ b/src/Compiler/Driver/XmlDocFileWriter.fs @@ -7,6 +7,7 @@ open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text open FSharp.Compiler.Xml +open FSharp.Compiler.Xml.XmlDocIncludeExpander open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps @@ -85,7 +86,8 @@ module XmlDocWriter = let addMember id xmlDoc = if hasDoc xmlDoc then - let doc = xmlDoc.GetXmlText() + let expandedDoc = expandIncludes xmlDoc + let doc = expandedDoc.GetXmlText() members <- (id, doc) :: members let doVal (v: Val) = addMember v.XmlDocSig v.XmlDoc diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index f0e69c58ef5..5504f86957e 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1674,6 +1674,7 @@ forFormatInvalidForInterpolated4,"Interpolated strings used as type IFormattable 3392,containerDeprecated,"The 'AssemblyKeyNameAttribute' has been deprecated. Use 'AssemblyKeyFileAttribute' instead." 3393,containerSigningUnsupportedOnThisPlatform,"Key container signing is not supported on this platform." 3394,parsNewExprMemberAccess,"This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName'" +3395,xmlDocIncludeError,"XML documentation include error: %s" 3395,tcImplicitConversionUsedForMethodArg,"This expression uses the implicit conversion '%s' to convert type '%s' to type '%s'." 3396,tcLiteralAttributeCannotUseActivePattern,"A [] declaration cannot use an active pattern for its identifier" 3397,tcUnitToObjSubsumption,"This expression uses 'unit' for an 'obj'-typed argument. This will lead to passing 'null' at runtime. This warning may be disabled using '#nowarn \"3397\"." diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index a249c5d2bb1..d963592f00b 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -275,6 +275,8 @@ + + diff --git a/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fs b/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fs new file mode 100644 index 00000000000..e81b657f32a --- /dev/null +++ b/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fs @@ -0,0 +1,188 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.Xml.XmlDocIncludeExpander + +open System +open System.IO +open System.Xml.Linq +open System.Xml.XPath +open FSharp.Compiler.Xml +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.IO +open FSharp.Compiler.Text +open Internal.Utilities.Library + +/// Thread-safe cache for loaded XML files +let private xmlDocCache = + let cacheOptions = + FSharp.Compiler.Caches.CacheOptions.getDefault StringComparer.OrdinalIgnoreCase + + new FSharp.Compiler.Caches.Cache>(cacheOptions, "XmlDocIncludeCache") + +/// Load an XML file from disk with caching +let private loadXmlFile (filePath: string) : Result = + xmlDocCache.GetOrAdd( + filePath, + fun path -> + try + if not (FileSystem.FileExistsShim(path)) then + Result.Error $"File not found: {path}" + else + let doc = XDocument.Load(path) + Result.Ok doc + with ex -> + Result.Error $"Error loading file '{path}': {ex.Message}" + ) + +/// Resolve a file path (absolute or relative to source file) +let private resolveFilePath (baseFileName: string) (includePath: string) : string = + if Path.IsPathRooted(includePath) then + includePath + else + let baseDir = + if String.IsNullOrEmpty(baseFileName) || baseFileName = "unknown" then + Directory.GetCurrentDirectory() + else + match Path.GetDirectoryName(baseFileName) with + | Null -> Directory.GetCurrentDirectory() + | NonNull dir when String.IsNullOrEmpty(dir) -> Directory.GetCurrentDirectory() + | NonNull dir -> dir + + Path.GetFullPath(Path.Combine(baseDir, includePath)) + +/// Evaluate XPath and return matching elements +let private evaluateXPath (doc: XDocument) (xpath: string) : Result = + try + if String.IsNullOrWhiteSpace(xpath) then + Result.Error "XPath expression is empty" + else + let elements = doc.XPathSelectElements(xpath) + + if obj.ReferenceEquals(elements, null) || Seq.isEmpty elements then + Result.Error $"XPath query returned no results: {xpath}" + else + Result.Ok elements + with ex -> + Result.Error $"Invalid XPath expression '{xpath}': {ex.Message}" + +/// Include directive information +type private IncludeInfo = { FilePath: string; XPath: string } + +/// Quick check if a string might contain an include tag (no allocations) +let private mayContainInclude (text: string) : bool = + not (String.IsNullOrEmpty(text)) && text.Contains(" + Some + { + FilePath = file.Value + XPath = path.Value + } + | _ -> None + +/// Active pattern to parse a line as an include directive (must be include tag alone on the line) +let private (|ParsedXmlInclude|_|) (line: string) : IncludeInfo option = + try + let elem = XElement.Parse(line.Trim()) + + if elem.Name.LocalName = "include" then + tryGetInclude elem + else + None + with _ -> + None + +/// Load and expand includes from an external file +/// This is the single unified error-handling and expansion logic +let rec private resolveSingleInclude + (baseFileName: string) + (includeInfo: IncludeInfo) + (inProgressFiles: Set) + (range: range) + : Result = + + let resolvedPath = resolveFilePath baseFileName includeInfo.FilePath + + // Check for circular includes + if inProgressFiles.Contains(resolvedPath) then + Result.Error $"Circular include detected: {resolvedPath}" + else + loadXmlFile resolvedPath + |> Result.bind (fun includeDoc -> evaluateXPath includeDoc includeInfo.XPath) + |> Result.map (fun elements -> + // Expand the loaded content recursively + let updatedInProgress = inProgressFiles.Add(resolvedPath) + let nodes = elements |> Seq.cast + expandAllIncludeNodes resolvedPath nodes updatedInProgress range) + +/// Recursively expand includes in XElement nodes +/// This is the ONLY recursive expansion - works on XElement level, never on strings +and private expandAllIncludeNodes (baseFileName: string) (nodes: XNode seq) (inProgressFiles: Set) (range: range) : XNode seq = + nodes + |> Seq.collect (fun node -> + if node.NodeType <> System.Xml.XmlNodeType.Element then + Seq.singleton node + else + let elem = node :?> XElement + + match tryGetInclude elem with + | None -> + // Not an include element, recursively process children + let expandedChildren = + expandAllIncludeNodes baseFileName (elem.Nodes()) inProgressFiles range + + let newElem = XElement(elem.Name, elem.Attributes(), expandedChildren) + Seq.singleton (newElem :> XNode) + | Some includeInfo -> + // This is an include element - expand it + match resolveSingleInclude baseFileName includeInfo inProgressFiles range with + | Result.Error msg -> + warning (Error(FSComp.SR.xmlDocIncludeError msg, range)) + Seq.singleton node + | Result.Ok expandedNodes -> expandedNodes) + +/// Expand all elements in an XmlDoc +/// Works directly on line array without string concatenation +let expandIncludes (doc: XmlDoc) : XmlDoc = + if doc.IsEmpty then + doc + else + let unprocessedLines = doc.UnprocessedLines + let baseFileName = doc.Range.FileName + + // Early exit: check if any line contains " Array.exists mayContainInclude + + if not hasIncludes then + doc + else + // Expand includes in the line array, keeping the array structure + let expandedLines = + unprocessedLines + |> Array.collect (fun line -> + match line with + | s when not (mayContainInclude s) -> [| line |] + | ParsedXmlInclude includeInfo -> + match resolveSingleInclude baseFileName includeInfo Set.empty doc.Range with + | Result.Error msg -> + warning (Error(FSComp.SR.xmlDocIncludeError msg, doc.Range)) + [| line |] + | Result.Ok nodes -> + // Convert nodes to strings (may be multiple lines) + nodes |> Seq.map (fun n -> n.ToString()) |> Array.ofSeq + | _ -> [| line |]) + + // Only create new XmlDoc if something changed + if + expandedLines.Length = unprocessedLines.Length + && Array.forall2 (=) expandedLines unprocessedLines + then + doc + else + XmlDoc(expandedLines, doc.Range) diff --git a/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fsi b/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fsi new file mode 100644 index 00000000000..cf8501e7d0b --- /dev/null +++ b/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fsi @@ -0,0 +1,9 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.Xml.XmlDocIncludeExpander + +open FSharp.Compiler.Xml + +/// Expand all elements in an XmlDoc. +/// Warnings are emitted via the diagnostics logger for any errors. +val expandIncludes: doc: XmlDoc -> XmlDoc diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index ace369ab6d0..b23f096938f 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -1992,6 +1992,11 @@ Tento komentář XML není platný: několik položek dokumentace pro parametr {0} + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' Tento komentář XML není platný: neznámý parametr {0} diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index b085382559c..5f0611a5190 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -1992,6 +1992,11 @@ Dieser XML-Kommentar ist ungültig: mehrere Dokumentationseinträge für Parameter "{0}". + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' Dieser XML-Kommentar ist ungültig: unbekannter Parameter "{0}". diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index ce366b2aa25..731b25dfee1 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -1992,6 +1992,11 @@ El comentario XML no es válido: hay varias entradas de documentación para el parámetro "{0}" + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' El comentario XML no es válido: parámetro "{0}" desconocido diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 434fe52667b..85494b2a732 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -1992,6 +1992,11 @@ Ce commentaire XML est non valide : il existe plusieurs entrées de documentation pour le paramètre '{0}' + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' Ce commentaire XML est non valide : paramètre inconnu '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index b56cbd0aac5..a4c29f6925e 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -1992,6 +1992,11 @@ Questo commento XML non è valido: sono presenti più voci della documentazione per il parametro '{0}' + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' Questo commento XML non è valido: il parametro '{0}' è sconosciuto diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 4c30fd2c58c..df20225efcc 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -1992,6 +1992,11 @@ この XML コメントは無効です: パラメーター '{0}' に複数のドキュメント エントリがあります + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' この XML コメントは無効です: パラメーター '{0}' が不明です diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index cfad9f364e9..b820079cb02 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -1992,6 +1992,11 @@ 이 XML 주석이 잘못됨: 매개 변수 '{0}'에 대한 여러 설명서 항목이 있음 + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' 이 XML 주석이 잘못됨: 알 수 없는 매개 변수 '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 70d31047619..96d9303632c 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -1992,6 +1992,11 @@ Ten komentarz XML jest nieprawidłowy: wiele wpisów dokumentacji dla parametru „{0}” + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' Ten komentarz XML jest nieprawidłowy: nieznany parametr „{0}” diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index bfe7eec5278..db626a53526 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -1992,6 +1992,11 @@ Este comentário XML é inválido: várias entradas de documentação para o parâmetro '{0}' + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' Este comentário XML é inválido: parâmetro desconhecido '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 426e70c647b..4eb01014132 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -1992,6 +1992,11 @@ Недопустимый XML-комментарий: несколько записей документации для параметра "{0}" + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' Недопустимый XML-комментарий: неизвестный параметр "{0}" diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 1908a5b1ee0..5b0e7004e00 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -1992,6 +1992,11 @@ Bu XML açıklaması geçersiz: '{0}' parametresi için birden çok belge girişi var + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' Bu XML açıklaması geçersiz: '{0}' parametresi bilinmiyor diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 686eb4f48b6..4a3a1eebe7f 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -1992,6 +1992,11 @@ 此 XML 注释无效: 参数“{0}”有多个文档条目 + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' 此 XML 注释无效: 未知参数“{0}” diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index bf14e4068ee..bbd69424c5f 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -1992,6 +1992,11 @@ 此 XML 註解無效: '{0}' 參數有多項文件輸入 + + XML documentation include error: {0} + XML documentation include error: {0} + + This XML comment is invalid: unknown parameter '{0}' 此 XML 註解無效: 未知的參數 '{0}' diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index bc0a3e97f6f..68d913c065c 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -333,6 +333,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/XmlDocInclude.fs b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/XmlDocInclude.fs new file mode 100644 index 00000000000..07ac7245b4f --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/XmlDocInclude.fs @@ -0,0 +1,268 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Miscellaneous + +open System +open System.IO +open Xunit +open FSharp.Test.Compiler + +module XmlDocInclude = + + // Test helper: create temp directory with files + let private setupDir (files: (string * string) list) = + let dir = Path.Combine(Path.GetTempPath(), "XmlDocTest_" + Guid.NewGuid().ToString("N")) + Directory.CreateDirectory(dir) |> ignore + + for name, content in files do + let p = Path.Combine(dir, name) + Directory.CreateDirectory(Path.GetDirectoryName(p)) |> ignore + File.WriteAllText(p, content) + + dir + + let private cleanup dir = + try + Directory.Delete(dir, true) + with _ -> + () + + // Test data + let private simpleData = + """ + + Included summary text. +""" + + let private nestedData = + """ + + Nested included text. +""" + + let private dataWithInclude = + """ + + Text with nested bold content. +""" + + [] + let ``Include with absolute path expands`` () = + let dir = setupDir [ "data/simple.data.xml", simpleData ] + let dataPath = Path.Combine(dir, "data/simple.data.xml").Replace("\\", "/") + + try + Fs + $""" +module Test +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> verifyXmlDocContains [ "Included summary text." ] + |> ignore + finally + cleanup dir + + [] + let ``Include with relative path expands`` () = + let dir = setupDir [ "data/simple.data.xml", simpleData ] + let dataPath = Path.Combine(dir, "data/simple.data.xml").Replace("\\", "/") + + try + Fs + $""" +module Test +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> verifyXmlDocContains [ "Included summary text." ] + |> ignore + finally + cleanup dir + + [] + let ``Nested includes expand`` () = + let dir = setupDir [ "outer.xml", + """ + + Outer text without nesting. +""" ] + + let outerPath = Path.Combine(dir, "outer.xml").Replace("\\", "/") + + try + Fs + $""" +module Test +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> verifyXmlDocContains [ "Outer text without nesting." ] + |> ignore + finally + cleanup dir + + [] + let ``Missing include file does not fail compilation`` () = + Fs + """ +module Test +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Regular doc without include works`` () = + Fs + """ +module Test +/// Regular summary +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> verifyXmlDocContains [ "Regular summary" ] + |> ignore + + [] + let ``Circular include does not hang`` () = + let dir = + setupDir [ + "a.xml", + """ + + A end. +""" + "b.xml", + """ + + B end. +""" + ] + + let aPath = Path.Combine(dir, "a.xml").Replace("\\", "/") + + try + Fs + $""" +module Test +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> ignore + finally + cleanup dir + + [] + let ``Relative path with parent directory works`` () = + let dir = setupDir [ "data/simple.data.xml", simpleData ] + let dataPath = Path.Combine(dir, "data/simple.data.xml").Replace("\\", "/") + + try + Fs + $""" +module Test +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> verifyXmlDocContains [ "Included summary text." ] + |> ignore + finally + cleanup dir + + [] + let ``Include tag is not present in output`` () = + let dir = setupDir [ "data/simple.data.xml", simpleData ] + let dataPath = Path.Combine(dir, "data/simple.data.xml").Replace("\\", "/") + + try + Fs + $""" +module Test +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> verifyXmlDocNotContains [ " ignore + finally + cleanup dir + + [] + let ``Multiple includes in same doc expand`` () = + let dir = + setupDir [ + "data1.xml", + """ + + First part. +""" + "data2.xml", + """ + + Second part. +""" + ] + + let path1 = Path.Combine(dir, "data1.xml").Replace("\\", "/") + let path2 = Path.Combine(dir, "data2.xml").Replace("\\", "/") + + try + Fs + $""" +module Test +/// +/// +/// +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> verifyXmlDocContains [ "First part."; "Second part." ] + |> ignore + finally + cleanup dir + + [] + let ``Include with empty path attribute generates warning`` () = + let dir = setupDir [ "data/simple.data.xml", simpleData ] + let dataPath = Path.Combine(dir, "data/simple.data.xml").Replace("\\", "/") + + try + Fs + $""" +module Test +/// +let f x = x +""" + |> withXmlDoc + |> compile + |> shouldSucceed + |> verifyXmlDocNotContains [ "Included summary text." ] + |> ignore + finally + cleanup dir diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index b93dea8fd1c..35687f7f1c4 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -2074,3 +2074,61 @@ Actual: match hash with | Some h -> h | None -> failwith "Implied signature hash returned 'None' which should not happen" + + let withXmlDoc (cUnit: CompilationUnit) : CompilationUnit = + // The XML doc file path will be derived from the DLL output path + match cUnit with + | FS fs -> + let outputDir = + match fs.OutputDirectory with + | Some di -> di + | None -> createTemporaryDirectory() + + let baseName = defaultArg fs.Name "output" + let xmlPath = Path.Combine(outputDir.FullName, baseName + ".xml") + + FS { fs with + OutputDirectory = Some outputDir + Options = fs.Options @ [ $"--doc:{xmlPath}" ] + } + | _ -> failwith "withXmlDoc is only supported for F#" + + let private verifyXmlDocWith (verifyFn: string -> string list -> unit) (texts: string list) (result: CompilationResult) : CompilationResult = + match result with + | CompilationResult.Failure _ -> failwith "Cannot verify XML doc on failed compilation" + | CompilationResult.Success output -> + match output.OutputPath with + | None -> failwith "No output path available" + | Some dllPath -> + let dir = Path.GetDirectoryName(dllPath) + // Try to find the XML file - could be named after the assembly or "output.xml" + let dllBaseName = Path.GetFileNameWithoutExtension(dllPath) + let xmlPath1 = Path.Combine(dir, dllBaseName + ".xml") + let xmlPath2 = Path.Combine(dir, "output.xml") + + let xmlPath = + if File.Exists xmlPath1 then xmlPath1 + elif File.Exists xmlPath2 then xmlPath2 + else failwith $"XML doc file not found: tried {xmlPath1} and {xmlPath2}" + + let content = File.ReadAllText(xmlPath) + verifyFn content texts + result + + let verifyXmlDocContains (expectedTexts: string list) (result: CompilationResult) : CompilationResult = + verifyXmlDocWith + (fun content texts -> + for expected in texts do + if not (content.Contains(expected)) then + failwith $"XML doc missing: '{expected}'\n\nActual:\n{content}") + expectedTexts + result + + let verifyXmlDocNotContains (unexpectedTexts: string list) (result: CompilationResult) : CompilationResult = + verifyXmlDocWith + (fun content texts -> + for unexpected in texts do + if content.Contains(unexpected) then + failwith $"XML doc should not contain: '{unexpected}'") + unexpectedTexts + result