Skip to content

Commit 6fa4fd6

Browse files
DedSec256T-Gro
DedSec256
and
T-Gro
authored
Do not check XmlDocs unless required (#14156)
Co-authored-by: Tomas Grosup <[email protected]>
1 parent 4ef42f7 commit 6fa4fd6

File tree

11 files changed

+88
-25
lines changed

11 files changed

+88
-25
lines changed

‎src/Compiler/Checking/CheckBasics.fs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module internal FSharp.Compiler.CheckBasics
44

55
open System.Collections.Generic
66

7+
open FSharp.Compiler.Diagnostics
78
open Internal.Utilities.Library
89
open Internal.Utilities.Library.Extras
910
open FSharp.Compiler
@@ -310,6 +311,8 @@ type TcFileState =
310311

311312
isInternalTestSpanStackReferring: bool
312313

314+
diagnosticOptions: FSharpDiagnosticOptions
315+
313316
// forward call
314317
TcPat: WarnOnUpperFlag -> TcFileState -> TcEnv -> PrelimValReprInfo option -> TcPatValFlags -> TcPatLinearEnv -> TType -> SynPat -> (TcPatPhase2Input -> Pattern) * TcPatLinearEnv
315318

@@ -328,7 +331,7 @@ type TcFileState =
328331

329332
/// Create a new compilation environment
330333
static member Create
331-
(g, isScript, amap, thisCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring,
334+
(g, isScript, amap, thisCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring, diagnosticOptions,
332335
tcPat,
333336
tcSimplePats,
334337
tcSequenceExpressionEntry,
@@ -358,6 +361,7 @@ type TcFileState =
358361
compilingCanonicalFslibModuleType = (isSig || not haveSig) && g.compilingFSharpCore
359362
conditionalDefines = conditionalDefines
360363
isInternalTestSpanStackReferring = isInternalTestSpanStackReferring
364+
diagnosticOptions = diagnosticOptions
361365
TcPat = tcPat
362366
TcSimplePats = tcSimplePats
363367
TcSequenceExpressionEntry = tcSequenceExpressionEntry

‎src/Compiler/Checking/CheckBasics.fsi‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
module internal FSharp.Compiler.CheckBasics
44

55
open System.Collections.Generic
6+
open FSharp.Compiler.Diagnostics
67
open Internal.Utilities.Library
78
open FSharp.Compiler.AccessibilityLogic
89
open FSharp.Compiler.CompilerGlobalState
@@ -260,6 +261,8 @@ type TcFileState =
260261

261262
isInternalTestSpanStackReferring: bool
262263

264+
diagnosticOptions: FSharpDiagnosticOptions
265+
263266
// forward call
264267
TcPat: WarnOnUpperFlag
265268
-> TcFileState
@@ -319,6 +322,7 @@ type TcFileState =
319322
tcSink: TcResultsSink *
320323
tcVal: TcValF *
321324
isInternalTestSpanStackReferring: bool *
325+
diagnosticOptions: FSharpDiagnosticOptions *
322326
tcPat: (WarnOnUpperFlag -> TcFileState -> TcEnv -> PrelimValReprInfo option -> TcPatValFlags -> TcPatLinearEnv -> TType -> SynPat -> (TcPatPhase2Input -> Pattern) * TcPatLinearEnv) *
323327
tcSimplePats: (TcFileState -> bool -> CheckConstraints -> TType -> TcEnv -> TcPatLinearEnv -> SynSimplePats -> string list * TcPatLinearEnv) *
324328
tcSequenceExpressionEntry: (TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv) *

‎src/Compiler/Checking/CheckDeclarations.fs‎

Lines changed: 36 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -456,14 +456,17 @@ module TcRecdUnionAndEnumDeclarations =
456456
let TcAnonFieldDecl cenv env parent tpenv nm (SynField(Attributes attribs, isStatic, idOpt, ty, isMutable, xmldoc, vis, m, _)) =
457457
let mName = m.MakeSynthetic()
458458
let id = match idOpt with None -> mkSynId mName nm | Some id -> id
459-
let xmlDoc = xmldoc.ToXmlDoc(true, Some [])
459+
460+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
461+
let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some [])
460462
TcFieldDecl cenv env parent false tpenv (isStatic, attribs, id, idOpt.IsNone, ty, isMutable, xmlDoc, vis, m)
461463

462464
let TcNamedFieldDecl cenv env parent isIncrClass tpenv (SynField(Attributes attribs, isStatic, id, ty, isMutable, xmldoc, vis, m, _)) =
463465
match id with
464466
| None -> error (Error(FSComp.SR.tcFieldRequiresName(), m))
465467
| Some id ->
466-
let xmlDoc = xmldoc.ToXmlDoc(true, Some [])
468+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
469+
let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some [])
467470
TcFieldDecl cenv env parent isIncrClass tpenv (isStatic, attribs, id, false, ty, isMutable, xmlDoc, vis, m)
468471

469472
let TcNamedFieldDecls cenv env parent isIncrClass tpenv fields =
@@ -552,7 +555,8 @@ module TcRecdUnionAndEnumDeclarations =
552555
|> Seq.map (fun f -> f.DisplayNameCore)
553556
|> Seq.toList
554557

555-
let xmlDoc = xmldoc.ToXmlDoc(true, Some names)
558+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
559+
let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some names)
556560
Construct.NewUnionCase id rfields recordTy attrs xmlDoc vis
557561

558562
let TcUnionCaseDecls (cenv: cenv) env (parent: ParentRef) (thisTy: TType) (thisTyInst: TypeInst) hasRQAAttribute tpenv unionCases =
@@ -571,7 +575,8 @@ module TcRecdUnionAndEnumDeclarations =
571575
let vis, _ = ComputeAccessAndCompPath env None m None None parent
572576
let vis = CombineReprAccess parent vis
573577
if id.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(), id.idRange))
574-
let xmlDoc = xmldoc.ToXmlDoc(true, Some [])
578+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
579+
let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some [])
575580
Construct.NewRecdField true (Some v) id false thisTy false false [] attrs xmlDoc vis false
576581

577582
let TcEnumDecls (cenv: cenv) env parent thisTy enumCases =
@@ -2197,7 +2202,9 @@ module TcExceptionDeclarations =
21972202
CheckForDuplicateConcreteType env (id.idText + "Exception") id.idRange
21982203
CheckForDuplicateConcreteType env id.idText id.idRange
21992204
let repr = TExnFresh (Construct.MakeRecdFieldsTable [])
2200-
let xmlDoc = xmlDoc.ToXmlDoc(true, Some [])
2205+
2206+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
2207+
let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, Some [])
22012208
Construct.NewExn cpath id vis repr attrs xmlDoc
22022209

22032210
let TcExnDefnCore_Phase1G_EstablishRepresentation (cenv: cenv) (env: TcEnv) parent (exnc: Entity) (SynExceptionDefnRepr(_, SynUnionCase(caseType=args), reprIdOpt, _, _, m)) =
@@ -2531,7 +2538,9 @@ module EstablishTypeDefinitionCores =
25312538

25322539
let envForDecls, moduleTyAcc = MakeInnerEnv true envInitial id moduleKind
25332540
let moduleTy = Construct.NewEmptyModuleOrNamespaceType moduleKind
2534-
let xmlDoc = xml.ToXmlDoc(true, Some [])
2541+
2542+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
2543+
let xmlDoc = xml.ToXmlDoc(checkXmlDocs, Some [])
25352544
let moduleEntity = Construct.NewModuleOrNamespace (Some envInitial.eCompPath) vis id xmlDoc modAttrs (MaybeLazy.Strict moduleTy)
25362545
let innerParent = Parent (mkLocalModuleRef moduleEntity)
25372546
let innerTypeNames = TypeNamesInMutRecDecls cenv envForDecls decls
@@ -2599,7 +2608,9 @@ module EstablishTypeDefinitionCores =
25992608

26002609
patNames
26012610
| _ -> []
2602-
let xmlDoc = xmlDoc.ToXmlDoc(true, Some paramNames )
2611+
2612+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
2613+
let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, Some paramNames )
26032614
Construct.NewTycon
26042615
(cpath, id.idText, id.idRange, vis, visOfRepr, TyparKind.Type, LazyWithContext.NotLazy checkedTypars,
26052616
xmlDoc, preferPostfix, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, lmodTy)
@@ -4485,7 +4496,9 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE
44854496
let id = ident (modName, id.idRange)
44864497

44874498
let moduleTy = Construct.NewEmptyModuleOrNamespaceType moduleKind
4488-
let xmlDoc = xml.ToXmlDoc(true, Some [])
4499+
4500+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
4501+
let xmlDoc = xml.ToXmlDoc(checkXmlDocs, Some [])
44894502
let moduleEntity = Construct.NewModuleOrNamespace (Some env.eCompPath) vis id xmlDoc attribs (MaybeLazy.Strict moduleTy)
44904503

44914504
let! moduleTy, _ = TcModuleOrNamespaceSignatureElementsNonMutRec cenv (Parent (mkLocalModuleRef moduleEntity)) env (id, moduleKind, moduleDefs, m, xml)
@@ -4590,8 +4603,9 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE
45904603
and TcSignatureElements cenv parent endm env xml mutRecNSInfo defs =
45914604
cancellable {
45924605
// Ensure the .Deref call in UpdateAccModuleOrNamespaceType succeeds
4593-
if cenv.compilingCanonicalFslibModuleType then
4594-
let xmlDoc = xml.ToXmlDoc(true, Some [])
4606+
if cenv.compilingCanonicalFslibModuleType then
4607+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
4608+
let xmlDoc = xml.ToXmlDoc(checkXmlDocs, Some [])
45954609
ensureCcuHasModuleOrNamespaceAtPath cenv.thisCcu env.ePath env.eCompPath xmlDoc
45964610

45974611
let typeNames = EstablishTypeDefinitionCores.TypeNamesInNonMutRecSigDecls defs
@@ -4817,7 +4831,9 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
48174831
// Create the new module specification to hold the accumulated results of the type of the module
48184832
// Also record this in the environment as the accumulator
48194833
let moduleTy = Construct.NewEmptyModuleOrNamespaceType moduleKind
4820-
let xmlDoc = xml.ToXmlDoc(true, Some [])
4834+
4835+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
4836+
let xmlDoc = xml.ToXmlDoc(checkXmlDocs, Some [])
48214837
let moduleEntity = Construct.NewModuleOrNamespace (Some env.eCompPath) vis id xmlDoc modAttrs (MaybeLazy.Strict moduleTy)
48224838

48234839
// Now typecheck.
@@ -5062,8 +5078,9 @@ and TcMutRecDefsFinish cenv defs m =
50625078
and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo openDecls0 synModuleDecls =
50635079
cancellable {
50645080
// Ensure the deref_nlpath call in UpdateAccModuleOrNamespaceType succeeds
5065-
if cenv.compilingCanonicalFslibModuleType then
5066-
let xmlDoc = xml.ToXmlDoc(true, Some [])
5081+
if cenv.compilingCanonicalFslibModuleType then
5082+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
5083+
let xmlDoc = xml.ToXmlDoc(checkXmlDocs, Some [])
50675084
ensureCcuHasModuleOrNamespaceAtPath cenv.thisCcu env.ePath env.eCompPath xmlDoc
50685085

50695086
// Collect the type names so we can implicitly add the compilation suffix to module names
@@ -5289,8 +5306,9 @@ let CheckOneImplFile
52895306
isInternalTestSpanStackReferring,
52905307
env,
52915308
rootSigOpt: ModuleOrNamespaceType option,
5292-
synImplFile) =
5293-
5309+
synImplFile,
5310+
diagnosticOptions) =
5311+
52945312
let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _)) = synImplFile
52955313
let infoReader = InfoReader(g, amap)
52965314

@@ -5304,6 +5322,7 @@ let CheckOneImplFile
53045322
let cenv =
53055323
cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt,
53065324
conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring,
5325+
diagnosticOptions,
53075326
tcPat=TcPat,
53085327
tcSimplePats=TcSimplePats,
53095328
tcSequenceExpressionEntry=TcSequenceExpressionEntry,
@@ -5426,7 +5445,7 @@ let CheckOneImplFile
54265445

54275446

54285447
/// Check an entire signature file
5429-
let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (sigFile: ParsedSigFileInput) =
5448+
let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring, diagnosticOptions) tcEnv (sigFile: ParsedSigFileInput) =
54305449
cancellable {
54315450
use _ =
54325451
Activity.start "CheckDeclarations.CheckOneSigFile"
@@ -5438,6 +5457,7 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin
54385457
cenv.Create
54395458
(g, false, amap, thisCcu, true, false, conditionalDefines, tcSink,
54405459
(LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring,
5460+
diagnosticOptions,
54415461
tcPat=TcPat,
54425462
tcSimplePats=TcSimplePats,
54435463
tcSequenceExpressionEntry=TcSequenceExpressionEntry,

‎src/Compiler/Checking/CheckDeclarations.fsi‎

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
module internal FSharp.Compiler.CheckDeclarations
44

5+
open FSharp.Compiler.Diagnostics
56
open Internal.Utilities.Library
67
open FSharp.Compiler.CheckBasics
78
open FSharp.Compiler.CompilerGlobalState
@@ -58,11 +59,19 @@ val CheckOneImplFile:
5859
bool *
5960
TcEnv *
6061
ModuleOrNamespaceType option *
61-
ParsedImplFileInput ->
62+
ParsedImplFileInput *
63+
FSharpDiagnosticOptions ->
6264
Cancellable<TopAttribs * CheckedImplFile * TcEnv * bool>
6365

6466
val CheckOneSigFile:
65-
TcGlobals * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines option * TcResultsSink * bool ->
67+
TcGlobals *
68+
ImportMap *
69+
CcuThunk *
70+
(unit -> bool) *
71+
ConditionalDefines option *
72+
TcResultsSink *
73+
bool *
74+
FSharpDiagnosticOptions ->
6675
TcEnv ->
6776
ParsedSigFileInput ->
6877
Cancellable<TcEnv * ModuleOrNamespaceType * bool>

‎src/Compiler/Checking/CheckExpressions.fs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2436,7 +2436,8 @@ module BindingNormalization =
24362436
let (NormalizedBindingPat(pat, rhsExpr, valSynData, typars)) =
24372437
NormalizeBindingPattern cenv cenv.nameResolver isObjExprBinding env valSynData headPat (NormalizedBindingRhs ([], retInfo, rhsExpr))
24382438
let paramNames = Some valSynData.SynValInfo.ArgNames
2439-
let xmlDoc = xmlDoc.ToXmlDoc(true, paramNames)
2439+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
2440+
let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames)
24402441
NormalizedBinding(vis, kind, isInline, isMutable, attrs, xmlDoc, typars, valSynData, pat, rhsExpr, mBinding, debugPoint)
24412442

24422443
//-------------------------------------------------------------------------
@@ -12089,7 +12090,8 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind
1208912090
| None -> None
1209012091
| Some valReprInfo -> Some valReprInfo.ArgNames
1209112092

12092-
let xmlDoc = xmlDoc.ToXmlDoc(true, paramNames)
12093+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
12094+
let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames)
1209312095
let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false)
1209412096

1209512097
assert(vspec.InlineInfo = inlineFlag)

‎src/Compiler/Checking/CheckIncrementalClasses.fs‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module internal FSharp.Compiler.CheckIncrementalClasses
44

55
open System
66

7+
open FSharp.Compiler.Diagnostics
78
open Internal.Utilities.Collections
89
open Internal.Utilities.Library
910
open Internal.Utilities.Library.Extras
@@ -135,7 +136,9 @@ let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attr
135136
let varReprInfo = InferGenericArityFromTyScheme prelimTyschemeG prelimValReprInfo
136137
let ctorValScheme = ValScheme(id, prelimTyschemeG, Some varReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, vis, false, true, false, false)
137138
let paramNames = varReprInfo.ArgNames
138-
let xmlDoc = xmlDoc.ToXmlDoc(true, Some paramNames)
139+
140+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
141+
let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, Some paramNames)
139142
let ctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValInRecScope isComplete, ctorValScheme, attribs, xmlDoc, None, false)
140143
ctorValScheme, ctorVal
141144

‎src/Compiler/Driver/ParseAndCheckInputs.fs‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1212,7 +1212,8 @@ let CheckOneInputAux
12121212
checkForErrors,
12131213
conditionalDefines,
12141214
tcSink,
1215-
tcConfig.internalTestSpanStackReferring)
1215+
tcConfig.internalTestSpanStackReferring,
1216+
tcConfig.diagnosticsOptions)
12161217
tcState.tcsTcSigEnv
12171218
file
12181219

@@ -1290,7 +1291,8 @@ let CheckOneInputAux
12901291
tcConfig.internalTestSpanStackReferring,
12911292
tcState.tcsTcImplEnv,
12921293
rootSigOpt,
1293-
file
1294+
file,
1295+
tcConfig.diagnosticsOptions
12941296
)
12951297

12961298
let tcState =
@@ -1485,7 +1487,8 @@ let CheckMultipleInputsInParallel
14851487
tcConfig.internalTestSpanStackReferring,
14861488
tcStateForImplFile.tcsTcImplEnv,
14871489
Some rootSig,
1488-
file
1490+
file,
1491+
tcConfig.diagnosticsOptions
14891492
)
14901493
|> Cancellable.runWithoutCancellation
14911494

‎src/Compiler/Facilities/DiagnosticOptions.fs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,3 +31,6 @@ type FSharpDiagnosticOptions =
3131
WarnAsError = []
3232
WarnAsWarn = []
3333
}
34+
35+
member x.CheckXmlDocs =
36+
List.contains 3390 x.WarnOn && not (List.contains 3390 x.WarnOff)

‎src/Compiler/Facilities/DiagnosticOptions.fsi‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,3 +22,5 @@ type FSharpDiagnosticOptions =
2222
WarnAsWarn: int list }
2323

2424
static member Default: FSharpDiagnosticOptions
25+
26+
member CheckXmlDocs: bool

‎tests/FSharp.Compiler.ComponentTests/Language/XmlComments.fs‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,17 @@ module M =
4949
"This XML comment is invalid: unknown parameter 'b'");
5050
]
5151

52+
[<Fact>]
53+
let ``diagnostic is not reported when disabled`` () =
54+
Fsx"""
55+
/// <summary> F </summary>
56+
/// <param name="x"> the parameter </param>
57+
let f a = a
58+
"""
59+
|> compile
60+
|> shouldSucceed
61+
|> withDiagnostics []
62+
5263
[<Fact>]
5364
let ``invalid parameter name is reported`` () =
5465
Fsx"""

0 commit comments

Comments
 (0)