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 a5b9fe2ed7a..04ff3437f61 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/10.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/10.0.200.md @@ -6,6 +6,7 @@ ### Added * FSharpDiagnostic: add default severity ([#19152](https://github.com/dotnet/fsharp/pull/19152)) +* Support for `` XML documentation tag ([Issue #19175](https://github.com/dotnet/fsharp/issues/19175)) ([PR #NNNNN](https://github.com/dotnet/fsharp/pull/NNNNN)) ### Breaking Changes diff --git a/src/Compiler/Driver/XmlDocFileWriter.fs b/src/Compiler/Driver/XmlDocFileWriter.fs index 004293087bf..08fec73f378 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,8 +86,9 @@ module XmlDocWriter = let addMember id xmlDoc = if hasDoc xmlDoc then - let doc = xmlDoc.GetXmlText() - members <- (id, doc) :: members + let xmlText = xmlDoc.GetXmlText() + let expandedText = expandIncludesInText xmlDoc.Range.FileName xmlText xmlDoc.Range + members <- (id, expandedText) :: members let doVal (v: Val) = addMember v.XmlDocSig v.XmlDoc diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 512e9b4dca7..09aac9ddb68 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1688,6 +1688,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..9114939081d --- /dev/null +++ b/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fs @@ -0,0 +1,178 @@ +// 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 + 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}" + +/// Recursively expand includes in XML content +let rec private expandIncludesInContent (baseFileName: string) (content: string) (inProgressFiles: Set) (range: range) : string = + // Early exit if content doesn't contain "= 0) then + content + else + try + // Wrap content in a root element to handle multiple top-level elements + let wrappedContent = "" + content + "" + let doc = XDocument.Parse(wrappedContent) + + let includeElements = doc.Descendants(!!(XName.op_Implicit "include")) |> Seq.toList + + if includeElements.IsEmpty then + content + else + let mutable modified = false + + for includeElem in includeElements do + let fileAttr = includeElem.Attribute(!!(XName.op_Implicit "file")) + let pathAttr = includeElem.Attribute(!!(XName.op_Implicit "path")) + + match fileAttr, pathAttr with + | Null, _ -> warning (Error(FSComp.SR.xmlDocIncludeError "Missing 'file' attribute", range)) + | _, Null -> warning (Error(FSComp.SR.xmlDocIncludeError "Missing 'path' attribute", range)) + | NonNull fileAttr, NonNull pathAttr -> + let includePath = fileAttr.Value + let xpath = pathAttr.Value + let resolvedPath = resolveFilePath baseFileName includePath + + // Check for circular includes + if inProgressFiles.Contains(resolvedPath) then + warning (Error(FSComp.SR.xmlDocIncludeError $"Circular include detected: {resolvedPath}", range)) + else + match loadXmlFile resolvedPath with + | Result.Error msg -> warning (Error(FSComp.SR.xmlDocIncludeError msg, range)) + | Result.Ok includeDoc -> + match evaluateXPath includeDoc xpath with + | Result.Error msg -> warning (Error(FSComp.SR.xmlDocIncludeError msg, range)) + | Result.Ok elements -> + // Get the inner content of selected elements + let newNodes = elements |> Seq.collect (fun elem -> elem.Nodes()) |> Seq.toList + + // Recursively expand includes in the loaded content + let updatedInProgress = inProgressFiles.Add(resolvedPath) + + let expandedNodes = + newNodes + |> List.map (fun node -> + if node.NodeType = System.Xml.XmlNodeType.Element then + let elemNode = node :?> XElement + let elemContent = elemNode.ToString() + + let expanded = + expandIncludesInContent resolvedPath elemContent updatedInProgress range + + XElement.Parse(expanded) :> XNode + else + node) + + // Replace the include element with expanded content + includeElem.ReplaceWith(expandedNodes) + modified <- true + + if modified then + // Extract content from root wrapper + match doc.Root with + | Null -> content + | NonNull root -> + let resultDoc = root.Nodes() |> Seq.map (fun n -> n.ToString()) |> String.concat "" + resultDoc + else + content + with ex -> + warning (Error(FSComp.SR.xmlDocIncludeError $"Error parsing XML: {ex.Message}", range)) + content + +/// Expand all elements in XML documentation text +let expandIncludesInText (baseFileName: string) (xmlText: string) (range: range) : string = + // Early exit if content doesn't contain "= 0) + then + xmlText + else + expandIncludesInContent baseFileName xmlText Set.empty range + +/// Expand all elements in an XmlDoc +let expandIncludes (doc: XmlDoc) : XmlDoc = + if doc.IsEmpty then + doc + else + // Get the elaborated XML text which includes proper XML structure + let content = doc.GetXmlText() + + // Early exit if content doesn't contain "= 0) then + doc + else + let baseFileName = doc.Range.FileName + + let expandedContent = + expandIncludesInContent baseFileName content Set.empty doc.Range + + // Create new XmlDoc with expanded content if it changed + if expandedContent = content then + doc + else + // Split back into lines to match the XmlDoc structure + let lines = + expandedContent.Split([| '\r'; '\n' |], StringSplitOptions.RemoveEmptyEntries) + + XmlDoc(lines, doc.Range) diff --git a/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fsi b/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fsi new file mode 100644 index 00000000000..8a4d2b4882b --- /dev/null +++ b/src/Compiler/SyntaxTree/XmlDocIncludeExpander.fsi @@ -0,0 +1,14 @@ +// 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 +open FSharp.Compiler.Text + +/// Expand all elements in XML documentation text. +/// Warnings are emitted via the diagnostics logger for any errors. +val expandIncludesInText: baseFileName: string -> xmlText: string -> range: range -> string + +/// 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 244be90e142..df1e9ad1773 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -2017,6 +2017,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 d1b1782d093..78542dbb6fd 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -2017,6 +2017,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 cd311cc7fc5..2d7163c353f 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -2017,6 +2017,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 e05e9ecdf6c..c358dbf3279 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -2017,6 +2017,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 a25fd816046..a4a782e80f8 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -2017,6 +2017,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 87b7d40df1e..b97196713f0 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -2017,6 +2017,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 f2fe6e20f97..3a60f9eb73f 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -2017,6 +2017,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 23a194ff258..dc4c2cd5b8b 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -2017,6 +2017,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 503fc0f073f..318dcedeb75 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -2017,6 +2017,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 7013fb0bc83..1d4d1f583d6 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -2017,6 +2017,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 49d2a295b45..b6416109bdc 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -2017,6 +2017,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 3fc65eebc96..b93e5709489 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -2017,6 +2017,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 07fea0efd23..da1c109b168 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -2017,6 +2017,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 c7c7127c070..4ca130c9843 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -331,6 +331,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..5e78651b655 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/XmlDocInclude.fs @@ -0,0 +1,248 @@ +// 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 "Test.xml" + |> 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 "Test.xml" + |> 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 "Test.xml" + |> 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 "Test.xml" + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Regular doc without include works`` () = + Fs + """ +module Test +/// Regular summary +let f x = x +""" + |> withXmlDoc "Test.xml" + |> 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 "Test.xml" + |> 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 "Test.xml" + |> 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 "Test.xml" + |> 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 "Test.xml" + |> compile + |> shouldSucceed + |> verifyXmlDocContains [ "First part."; "Second part." ] + |> ignore + finally + cleanup dir diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 5df00581c7f..d3bc6993d28 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -2092,3 +2092,72 @@ Actual: match hash with | Some h -> h | None -> failwith "Implied signature hash returned 'None' which should not happen" + + let withXmlDoc (_xmlFileName: string) (cUnit: CompilationUnit) : CompilationUnit = + // We ignore the xmlFileName and always derive the XML path from the DLL output path + // The actual --doc path will be constructed at compile time + match cUnit with + | FS fs -> + // We'll use a marker that gets replaced during compilation + // or we ensure the output directory is set so we can construct the path + 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 verifyXmlDocContains (expectedTexts: 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) + for expected in expectedTexts do + if not (content.Contains(expected)) then + failwith $"XML doc missing: '{expected}'\n\nActual:\n{content}" + result + + let verifyXmlDocNotContains (unexpectedTexts: 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) + for unexpected in unexpectedTexts do + if content.Contains(unexpected) then + failwith $"XML doc should not contain: '{unexpected}'" + result