diff --git a/src/Fable.Cli/Main.fs b/src/Fable.Cli/Main.fs index 9adcfd787..711b88e5f 100644 --- a/src/Fable.Cli/Main.fs +++ b/src/Fable.Cli/Main.fs @@ -15,7 +15,7 @@ open Fable.Transforms.State open Fable.Compiler.ProjectCracker open Fable.Compiler.Util -module private Util = +module Util = type PathResolver with static member Dummy = @@ -78,10 +78,18 @@ module private Util = | Severity.Error -> "error" | Severity.Info -> "info" + // MSBuild-style ` `: without the code there is no way to + // discover what to put in a `// fable-disable-line` comment, and rendering it here + // also makes Fable warnings parseable by IDEs and MSBuild loggers. + let tag = + match log.Code with + | Some code -> $"%s{log.Tag} %s{code}" + | None -> log.Tag + match log.Range with | Some r -> - $"%s{file}(%i{r.start.line},%i{r.start.column}): (%i{r.``end``.line},%i{r.``end``.column}) %s{severity} %s{log.Tag}: %s{log.Message}" - | None -> $"%s{file}(1,1): %s{severity} %s{log.Tag}: %s{log.Message}" + $"%s{file}(%i{r.start.line},%i{r.start.column}): (%i{r.``end``.line},%i{r.``end``.column}) %s{severity} %s{tag}: %s{log.Message}" + | None -> $"%s{file}(1,1): %s{severity} %s{tag}: %s{log.Message}" let logErrors rootDir (logs: LogEntry seq) = logs @@ -356,6 +364,18 @@ type FsWatcher(delayMs: int) = type ProjectCracked(cliArgs: CliArgs, crackerResponse: CrackerResponse, sourceFiles: Fable.Compiler.File array) = + let sourceReader = lazy (snd (Fable.Compiler.File.MakeSourceReader sourceFiles)) + + // Shared by every file of the project: a warning can point at any file (inlined calls) and + // files compile in parallel. A new ProjectCracked is built on every watch rebuild, so this + // never outlives the source it was computed from. + let warningSuppression = + lazy + (WarningSuppression.Resolver.FromCompilerOptions( + crackerResponse.ProjectOptions.OtherOptions, + sourceReader.Value + )) + member _.CliArgs = cliArgs member _.ProjectFile = cliArgs.ProjectFile member _.FableOptions = cliArgs.CompilerOptions @@ -392,9 +412,32 @@ type ProjectCracked(cliArgs: CliArgs, crackerResponse: CrackerResponse, sourceFi fableLibDir, crackerResponse.OutputType, ?outDir = cliArgs.OutDir, - ?watchDependencies = watchDependencies + ?watchDependencies = watchDependencies, + warningSuppression = warningSuppression.Value ) + /// Problems with the `fable-disable` directives themselves (typo'd codes, directives that + /// suppress nothing). Only valid once every file has been compiled, since a directive in one + /// file can be what suppresses a warning raised while compiling another. + member _.DirectiveDiagnostics(files: string seq) = + warningSuppression.Value.GetDiagnostics(files) + |> List.map (fun (file, d) -> + let pos: Position = + { + line = d.Line + column = 0 + } + + LogEntry.Make( + Severity.Warning, + d.Message, + fileName = file, + range = SourceLocation.Create(pos, pos, file), + code = d.Code + ) + ) + |> Array.ofList + member _.MapSourceFiles(f) = ProjectCracked(cliArgs, crackerResponse, Array.map f sourceFiles) @@ -1444,6 +1487,11 @@ let private compilationCycle (state: State) (changes: ISet) = Array.append logs [| log |], deps ) + // Every file is compiled by now, so a directive that still hasn't suppressed anything + // really is unused - checking earlier would flag directives that only ever fire for a + // warning raised while some later file was being compiled. + let logs = Array.append logs (projCracked.DirectiveDiagnostics filesToCompile) + let state = { state with PendingFiles = [||] diff --git a/src/Fable.Compiler/Library.fs b/src/Fable.Compiler/Library.fs index e7b6c7c6d..600556081 100644 --- a/src/Fable.Compiler/Library.fs +++ b/src/Fable.Compiler/Library.fs @@ -180,7 +180,12 @@ module CodeServices = opts, fableLibDir, crackerResponse.OutputType, - ?outDir = cliArgs.OutDir + ?outDir = cliArgs.OutDir, + warningSuppression = + WarningSuppression.Resolver.FromCompilerOptions( + crackerResponse.ProjectOptions.OtherOptions, + sourceReader + ) ) // TODO: make it configurable if FableTransforms.transformFile is applied? @@ -220,6 +225,9 @@ module CodeServices = async { let fableLibDir = Path.getRelativePath currentFile crackerResponse.FableLibDir + // No `warningSuppression`: this overload is handed an already type-checked + // project rather than a `SourceReader`, so there is no source to scan for + // `// fable-disable` comments. Not a bug, just a limitation of the entry point. let compiler: Compiler = CompilerImpl( currentFile, @@ -305,6 +313,12 @@ module CodeServices = let opts = cliArgs.CompilerOptions + let warningSuppression = + WarningSuppression.Resolver.FromCompilerOptions( + crackerResponse.ProjectOptions.OtherOptions, + sourceReader + ) + let! compiledFiles = dependentFiles |> Array.filter (fun filePath -> not (filePath.EndsWith(".fsi", StringComparison.Ordinal))) @@ -319,7 +333,8 @@ module CodeServices = opts, fableLibDir, crackerResponse.OutputType, - ?outDir = cliArgs.OutDir + ?outDir = cliArgs.OutDir, + warningSuppression = warningSuppression ) let outputPath = Path.ChangeExtension(currentFile, ".js") diff --git a/src/Fable.Transforms/Babel/Fable2Babel.fs b/src/Fable.Transforms/Babel/Fable2Babel.fs index e9312c080..3fe120a95 100644 --- a/src/Fable.Transforms/Babel/Fable2Babel.fs +++ b/src/Fable.Transforms/Babel/Fable2Babel.fs @@ -4987,8 +4987,8 @@ module Compiler = member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string) = - com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag) + member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string, ?code: string) = + com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag, ?code = code) let makeCompiler com = BabelCompiler(com) diff --git a/src/Fable.Transforms/Beam/Fable2Beam.fs b/src/Fable.Transforms/Beam/Fable2Beam.fs index 2f49d7df7..a5ac265d2 100644 --- a/src/Fable.Transforms/Beam/Fable2Beam.fs +++ b/src/Fable.Transforms/Beam/Fable2Beam.fs @@ -3760,8 +3760,8 @@ let transformFile (com: Fable.Compiler) (file: File) : Beam.ErlModule = member _.GetInlineExpr(key) = com.GetInlineExpr(key) member _.AddWatchDependency(file) = com.AddWatchDependency(file) - member _.AddLog(msg, severity, ?range, ?fileName, ?tag) = - com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag) + member _.AddLog(msg, severity, ?range, ?fileName, ?tag, ?code) = + com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag, ?code = code) } let forms = diff --git a/src/Fable.Transforms/Dart/Fable2Dart.fs b/src/Fable.Transforms/Dart/Fable2Dart.fs index 788a68ad0..26114be2d 100644 --- a/src/Fable.Transforms/Dart/Fable2Dart.fs +++ b/src/Fable.Transforms/Dart/Fable2Dart.fs @@ -3117,8 +3117,8 @@ module Compiler = member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string) = - com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag) + member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string, ?code: string) = + com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag, ?code = code) let makeCompiler com = DartCompiler(com) diff --git a/src/Fable.Transforms/Dart/Replacements.fs b/src/Fable.Transforms/Dart/Replacements.fs index aed42ea52..cf914cfe5 100644 --- a/src/Fable.Transforms/Dart/Replacements.fs +++ b/src/Fable.Transforms/Dart/Replacements.fs @@ -1395,7 +1395,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "GetEnumerator", Some c, _ -> stringToCharSeq c |> getEnumerator com r t |> Some | ("Contains" | "StartsWith" | "EndsWith" as meth), Some c, arg :: _ -> if List.isMultiple args then - addWarning com ctx.InlinePath r $"String.%s{meth}: second argument is ignored" + WarningCodes.stringComparisonIgnored |> addWarningWithCode com ctx.InlinePath r Helper.InstanceCall(c, Naming.lowerFirst meth, t, [ arg ], ?loc = r) |> Some | ReplaceName [ "ToUpper", "toUpperCase" @@ -2085,8 +2085,8 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let intConst = int System.Globalization.NumberStyles.Integer if style <> hexConst && style <> intConst then - $"%s{i.DeclaringEntityFullName}.%s{meth}(): NumberStyle %d{style} is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.numberStylesIgnored style + |> addWarningWithCode com ctx.InlinePath r let acceptedArgs = if meth = "Parse" then @@ -2094,10 +2094,13 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op else 3 - if List.length args > acceptedArgs then + match List.tryItem acceptedArgs args with + // InvariantCulture asks for exactly what Fable does, so there is nothing to report. + | None + | Some InvariantCulture -> () + | Some _ -> // e.g. Double.Parse(string, style, IFormatProvider) etc. - $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r parseCall meth str args style | ("Parse" | "TryParse") as meth, str :: _ -> @@ -2107,10 +2110,13 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op else 2 - if List.length args > acceptedArgs then + match List.tryItem acceptedArgs args with + // InvariantCulture asks for exactly what Fable does, so there is nothing to report. + | None + | Some InvariantCulture -> () + | Some _ -> // e.g. Double.Parse(string, IFormatProvider) etc. - $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r let style = int System.Globalization.NumberStyles.Any parseCall meth str args style @@ -2708,8 +2714,7 @@ let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) ( | "ToBase64String" | "FromBase64String" -> if not (List.isSingle args) then - $"Convert.%s{Naming.upperFirst i.CompiledName} only accepts one single argument" - |> addWarning com ctx.InlinePath r + WarningCodes.base64ArgumentsIgnored |> addWarningWithCode com ctx.InlinePath r Helper.LibCall( com, @@ -2858,11 +2863,33 @@ let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio Helper.InstanceCall(thisArg.Value, meth, t, args, ?loc = r) |> Some | meth -> + // Drops the IFormatProvider (and DateTimeStyles, where present), warning once per + // discarded argument. `Parse arg` with no extra argument discards nothing. let args = + // Passing InvariantCulture asks for exactly what Fable does, so nothing to report. + let warnProvider culture = + match culture with + | InvariantCulture -> () + | _ -> WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r + + let warnStyles styles = + match styles with + | NumberConst(NumberValue.Int32 0, _) -> () // DateTimeStyles.None: no special handling + | _ -> WarningCodes.dateTimeStylesIgnored |> addWarningWithCode com ctx.InlinePath r + match meth, args with - // Ignore IFormatProvider + | "Parse", arg :: culture :: styles :: _ -> + warnProvider culture + warnStyles styles + [ arg ] + | "Parse", arg :: culture :: _ -> + warnProvider culture + [ arg ] | "Parse", arg :: _ -> [ arg ] - | "TryParse", input :: _culture :: _styles :: defVal :: _ -> [ input; defVal ] + | "TryParse", input :: culture :: styles :: defVal :: _ -> + warnProvider culture + warnStyles styles + [ input; defVal ] | _ -> args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 4e25f6b74..49bd3c360 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -2857,8 +2857,8 @@ type FableCompiler(com: Compiler) = member _.GetInlineExpr(fullName) = com.GetInlineExpr(fullName) member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string) = - com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag) + member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string, ?code: string) = + com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag, ?code = code) let rec attachClassMembers (com: FableCompiler) = diff --git a/src/Fable.Transforms/Fable.Transforms.fsproj b/src/Fable.Transforms/Fable.Transforms.fsproj index 738cab2bb..86cbef389 100644 --- a/src/Fable.Transforms/Fable.Transforms.fsproj +++ b/src/Fable.Transforms/Fable.Transforms.fsproj @@ -5,6 +5,8 @@ + + diff --git a/src/Fable.Transforms/Global/Compiler.fs b/src/Fable.Transforms/Global/Compiler.fs index 7b2b2ac97..cb33b5e9a 100644 --- a/src/Fable.Transforms/Global/Compiler.fs +++ b/src/Fable.Transforms/Global/Compiler.fs @@ -86,7 +86,8 @@ type Compiler = abstract AddWatchDependency: file: string -> unit abstract AddLog: - msg: string * severity: Severity * ?range: SourceLocation * ?fileName: string * ?tag: string -> unit + msg: string * severity: Severity * ?range: SourceLocation * ?fileName: string * ?tag: string * ?code: string -> + unit type InlineExprLazy(f: Compiler -> InlineExpr) = let mutable value: InlineExpr voption = ValueNone diff --git a/src/Fable.Transforms/Global/WarningCodes.fs b/src/Fable.Transforms/Global/WarningCodes.fs new file mode 100644 index 000000000..885c40dde --- /dev/null +++ b/src/Fable.Transforms/Global/WarningCodes.fs @@ -0,0 +1,97 @@ +(* + Central registry for Fable warnings codes + + - `FABLE0001`-`FABLE0099` describe Fable's own suppression directivers. They are never suppressible. + - `FABLE0100` and up describe code from compilation result. Those can be suppressed +*) +module Fable.Transforms.WarningCodes + +/// Can a `// fable-disable` comment silence a warning carrying this code? Codes below +/// `FABLE0100` describe the directives themselves and never can - see the band rules above. +/// This is what makes the banding an invariant rather than a naming convention: it holds +/// wherever a diagnostic is raised from, not just on the path that happens to raise them today. +/// +/// `None` is a warning with no code at all, which a bare `// fable-disable-line` still catches. +let isSuppressible (code: string option) = + match code with + | None -> true + // Every code is `FABLE` plus four digits, so ordinal comparison orders them numerically. + | Some code -> System.String.CompareOrdinal(code, "FABLE0100") >= 0 + +(* + FABLE0001-0099: about Fable's own directives. Never suppressible. +*) + +/// A `fable-disable*` directive named something that isn't in this registry - most likely a typo. +let unknownSuppressionCode (code: string) = + "FABLE0001", $"Unknown warning code '%s{code}' in a fable-disable directive" + +/// A `fable-disable*` directive that never suppressed anything, so it can be deleted. +let unusedSuppressionDirective = + "FABLE0002", "This fable-disable directive doesn't suppress anything" + +/// A bare `// fable-disable` block, which would silence every Fable warning up to end of file. +let suppressionBlockWithoutCode = + "FABLE0003", + "A 'fable-disable' block must list the warning codes it suppresses, otherwise it silences every Fable warning until the end of the file" + +(* + FABLE0100 and up: about the compiled code. Suppressible. +*) + +/// `String.StartsWith`/`EndsWith` with a `CultureInfo` argument: the comparison always runs +/// with the target's default culture rules, the argument is accepted but has no effect. +/// Used in both the JS/TS and Python replacements. +let cultureInfoIgnored = "FABLE0100", "CultureInfo argument is ignored" + +/// Dart's `contains`/`startsWith`/`endsWith` are ordinal and case-sensitive, so a +/// `StringComparison` or `CultureInfo` asking for anything else has no effect. +let stringComparisonIgnored = "FABLE0101", "String comparison argument is ignored" + +/// An `IFormatProvider`/`CultureInfo` passed to a `Parse`/`TryParse`, `String.Format` or +/// `StringBuilder.AppendFormat` overload. Fable is culture-independent here, so a culture that +/// changes the decimal separator or the day/month order silently changes the result. +let formatProviderIgnored = "FABLE0102", "Format provider argument is ignored" + +/// A `NumberStyles` value that isn't `Integer` or `HexNumber` passed to a numeric `Parse`. The +/// value is interpolated because the range can't tell you which style was discarded. +let numberStylesIgnored (style: int) = + "FABLE0103", $"NumberStyles argument %d{style} is ignored" + +/// A `DateTimeStyles` value passed to a date/time `Parse`. +let dateTimeStylesIgnored = "FABLE0104", "DateTimeStyles argument is ignored" + +/// A `TimeSpan` constructed with a microseconds argument. The runtime representation only carries +/// milliseconds, so the finer component is dropped rather than rounded. +let timeSpanPrecisionIgnored = + "FABLE0105", "TimeSpan precision is limited to milliseconds, microsecond arguments are ignored" + +/// `FSharpType.IsUnion(t, allowAccessToPrivateRepresentation)` and friends. Fable's reflection +/// has no notion of a private representation, so the flag never restricts anything. +let privateRepresentationFlagIgnored = + "FABLE0106", "Private representation flag is ignored" + +/// `Convert.ToBase64String(bytes, offset, length)` / `(bytes, options)`. Only the array is used, +/// so a slice is encoded whole and line-break options have no effect. +let base64ArgumentsIgnored = + "FABLE0107", "Base64 offset, length and formatting arguments are ignored" + +/// Every code the compiler can emit, both bands. A directive naming anything else is reported as +/// a typo, so a new warning MUST be added to this list as well as defined above. +let knownCodes = + [ + // The two parameterised warnings get a throwaway argument; only the code is read. + unknownSuppressionCode "" + unusedSuppressionDirective + suppressionBlockWithoutCode + cultureInfoIgnored + stringComparisonIgnored + formatProviderIgnored + numberStylesIgnored 0 + dateTimeStylesIgnored + timeSpanPrecisionIgnored + privateRepresentationFlagIgnored + base64ArgumentsIgnored + ] + |> List.map fst + |> Set.ofList diff --git a/src/Fable.Transforms/Global/WarningSuppression.fs b/src/Fable.Transforms/Global/WarningSuppression.fs new file mode 100644 index 000000000..d6f3c2b96 --- /dev/null +++ b/src/Fable.Transforms/Global/WarningSuppression.fs @@ -0,0 +1,436 @@ +(* + Computes which diagnostics `// fable-disable/-enable...` comments suppress (ESLint's + disable-line/next-line/block model), via real comment tokens - not raw text matching. +*) +module Fable.Transforms.WarningSuppression + +open Fable +open System.Collections.Concurrent +open System.Text.RegularExpressions +open FSharp.Compiler.Tokenization + +type private DirectiveKind = + | DisableLine + | DisableNextLine + | Disable + | Enable + +[] +type private Directive = + { + Kind: DirectiveKind + /// `None` means "every code" + Codes: Set option + Line: int + /// Set the first time this directive suppresses something. + mutable Used: bool + /// Set when the directive was already reported for something else (typo'd code, bare + /// block): no point telling the user it is unused on top of that. + mutable Reported: bool + } + +type private BlockState = + | NoneDisabled + /// Blanket disable opened by this directive, minus the codes since re-enabled. + | AllDisabledExcept of opener: Directive * enabled: Set + /// code -> the directive that disabled it + | SpecificDisabled of Map + +/// A problem with a directive itself (typo'd code, directive that suppresses nothing, ...), +/// reported once the file it belongs to has finished compiling. +type DirectiveDiagnostic = + { + Code: string + Message: string + Line: int + } + +// The name must be followed by end-of-comment, whitespace or `:` so that `fable-disabled` or +// `fable-disable-lines` aren't mistaken for a bare directive. `:` is then optionally consumed +let private directiveRegex = + Regex(@"^fable-(disable-next-line|disable-line|disable|enable)(?=$|\s|:)\s*:?\s*(.*)$", RegexOptions.Compiled) + +let private codeSeparators = [| ' '; ','; '\t' |] + +/// Cheap pre-filter: tokenizing a source file to look for directives that aren't there is pure +/// waste, and the vast majority of files contain none. +let private mayContainDirectives (source: string) = + source.IndexOf("fable-disable", System.StringComparison.Ordinal) >= 0 + || source.IndexOf("fable-enable", System.StringComparison.Ordinal) >= 0 + +/// Splits a directive's argument text into codes, dropping the ESLint-style ` -- justification` +/// tail. Codes are upper-cased so `fable0001` matches, and anything not in the registry is +/// returned separately so the caller can report the typo instead of silently ignoring it. +let private parseCodes (raw: string) : Set option * string list = + let raw = + match raw.IndexOf("--", System.StringComparison.Ordinal) with + | -1 -> raw + | i -> raw.Substring(0, i) + + let tokens = + raw.Split(codeSeparators, System.StringSplitOptions.RemoveEmptyEntries) + |> Array.map (fun t -> t.ToUpperInvariant()) + + let known, unknown = tokens |> Array.partition WarningCodes.knownCodes.Contains + + let codes = + if Array.isEmpty tokens then + None + else + Some(Set.ofArray known) + + codes, List.ofArray unknown + +let private stripCommentMarkers (raw: string) = + let raw = + if raw.StartsWith("//", System.StringComparison.Ordinal) then + raw.Substring(2) + elif raw.StartsWith("(*", System.StringComparison.Ordinal) then + raw.Substring(2) + else + raw + + let raw = + if raw.EndsWith("*)", System.StringComparison.Ordinal) then + raw.Substring(0, raw.Length - 2) + else + raw + + raw.Trim() + +let private tryParseDirective (line: int) (commentText: string) : (Directive * string list) option = + let text = stripCommentMarkers commentText + let m = directiveRegex.Match(text) + + if not m.Success then + None + else + let codes, unknown = parseCodes m.Groups[2].Value + + let kind = + match m.Groups[1].Value with + | "disable-line" -> Some DisableLine + | "disable-next-line" -> Some DisableNextLine + | "disable" -> Some Disable + | "enable" -> Some Enable + | _ -> None + + kind + |> Option.map (fun kind -> + { + Kind = kind + Codes = codes + Line = line + Used = false + Reported = false + }, + unknown + ) + +/// Gathers each line's comment token runs as plain text (a line can have more than one, e.g. a +/// block comment then a trailing line comment); also returns the lexer state to carry into the +/// next line, needed to resume correctly inside multi-line block comments/strings. +let private scanLineComments + (tokenizer: FSharpLineTokenizer) + (initialState: FSharpTokenizerLexState) + (line: string) + : string list * FSharpTokenizerLexState + = + // Each finished run is one comment on the line; `current` is the run being built. + let runs = ResizeArray() + let mutable current: System.Text.StringBuilder option = None + + // Pull tokens one at a time, threading the lexer state (needed across lines too). + let rec loop state = + match tokenizer.ScanToken(state) with + | Some(tok: FSharpTokenInfo), state2 -> + if tok.ColorClass = FSharpTokenColorKind.Comment then + let text = line.Substring(tok.LeftColumn, tok.RightColumn - tok.LeftColumn + 1) + + match current with + // Still inside the same comment: glue this token onto the current run. + | Some sb -> sb.Append(text) |> ignore + // First comment token after non-comment text: start a new run. + | None -> + let sb = System.Text.StringBuilder(text: string) + current <- Some sb + runs.Add(sb) + else + // Non-comment token: close the current run, if any (e.g. code between two comments). + current <- None + + loop state2 + // No more tokens on this line: return the final state for the next line. + | None, state2 -> state2 + + let endState = loop initialState + // Materialize each run's text; endState lets the caller resume correctly on the next line. + (runs |> Seq.map _.ToString() |> List.ofSeq), endState + +/// Computed, queryable suppression info for a single source file. +type FileSuppressions = + private + { + /// Every parsed directive, in source order. + Directives: Directive[] + /// 1-based line -> the line-scoped directives landing on it + LineOnly: Map + /// index (line - 1) -> block-disable state as of (and including) that line + BlockAtLine: BlockState[] + /// Problems found while parsing (typo'd codes, bare block disables) + ParseDiagnostics: DirectiveDiagnostic list + } + + /// Is a diagnostic with the given code (None = no code assigned to it) suppressed anywhere in + /// `[startLine, endLine]`? Line-scoped directives match on any line of the range, so a + /// trailing `// fable-disable-line` still works on a multi-line expression. The block state is + /// read at `startLine` only: a `fable-disable` buried inside a large expression shouldn't + /// retroactively silence a warning anchored above it. + member this.IsSuppressed(startLine: int, endLine: int, code: string option) = + let matches (d: Directive) = + match d.Codes with + | None -> true + | Some codes -> code |> Option.map codes.Contains |> Option.defaultValue false + + let mutable suppressed = false + + for line in startLine .. max startLine endLine do + match Map.tryFind line this.LineOnly with + | Some directives -> + for d in directives do + if matches d then + d.Used <- true + suppressed <- true + | None -> () + + if not suppressed && startLine >= 1 && startLine <= this.BlockAtLine.Length then + match this.BlockAtLine[startLine - 1] with + | NoneDisabled -> () + | AllDisabledExcept(opener, enabled) -> + let hit = + match code with + | None -> true + | Some c -> not (Set.contains c enabled) + + if hit then + opener.Used <- true + suppressed <- true + | SpecificDisabled disabled -> + match code |> Option.bind (fun c -> Map.tryFind c disabled) with + | Some opener -> + opener.Used <- true + suppressed <- true + | None -> () + + suppressed + + member this.IsSuppressed(line: int, code: string option) = this.IsSuppressed(line, line, code) + + /// Parse problems plus every directive that never suppressed anything. Only meaningful once + /// the whole compilation is over: an inlined call can suppress through a directive in a file + /// other than the one currently being compiled. + member this.GetDiagnostics() = + let unused = + this.Directives + |> Array.choose (fun d -> + // `fable-enable` re-opens warnings rather than suppressing them, so "unused" has + // no meaning for it - ESLint doesn't report those either. A directive whose codes + // are already reported as typos is obviously unused too; one message is enough. + if d.Kind = Enable || d.Used || d.Reported then + None + else + let code, message = WarningCodes.unusedSuppressionDirective + + Some + { + Code = code + Message = message + Line = d.Line + } + ) + |> List.ofArray + + this.ParseDiagnostics @ unused + + static member Empty = + { + Directives = [||] + LineOnly = Map.empty + BlockAtLine = [||] + ParseDiagnostics = [] + } + +/// Folds one `fable-disable`/`fable-enable` into the running block state. The directive itself is +/// carried through so that whatever it ends up suppressing can mark it used. +let private transition (state: BlockState) (d: Directive) = + match d.Kind = Disable, d.Codes, state with + | true, None, _ -> AllDisabledExcept(d, Set.empty) + | true, Some codes, NoneDisabled -> SpecificDisabled(codes |> Seq.map (fun c -> c, d) |> Map.ofSeq) + | true, Some codes, SpecificDisabled m -> SpecificDisabled((m, codes) ||> Seq.fold (fun m c -> Map.add c d m)) + | true, Some codes, AllDisabledExcept(opener, ex) -> AllDisabledExcept(opener, Set.difference ex codes) + | false, None, _ -> NoneDisabled + | false, Some _, NoneDisabled -> NoneDisabled + | false, Some codes, SpecificDisabled m -> SpecificDisabled((m, codes) ||> Seq.fold (fun m c -> Map.remove c m)) + | false, Some codes, AllDisabledExcept(opener, ex) -> AllDisabledExcept(opener, Set.union ex codes) + +let private computeDirectives (defines: string list) (source: string) = + let lines = source.Replace("\r\n", "\n").Split('\n') + let sourceTok = FSharpSourceTokenizer(defines, None, None, None) + let directives = ResizeArray() + let parseDiagnostics = ResizeArray() + let mutable state = FSharpTokenizerLexState.Initial + + for i in 0 .. lines.Length - 1 do + let lineNo = i + 1 + let tokenizer = sourceTok.CreateLineTokenizer(lines[i]) + let runs, newState = scanLineComments tokenizer state lines[i] + state <- newState + + for run in runs do + match tryParseDirective lineNo run with + | None -> () + | Some(directive, unknownCodes) -> + let flag (code, message) = + directive.Reported <- true + + parseDiagnostics.Add + { + Code = code + Message = message + Line = lineNo + } + + for unknown in unknownCodes do + flag (WarningCodes.unknownSuppressionCode unknown) + + // A bare `fable-disable` block silences every Fable warning to end of file, which + // is almost never what people mean - flag it, but honour it. + if directive.Kind = Disable && Option.isNone directive.Codes then + flag WarningCodes.suppressionBlockWithoutCode + + directives.Add directive + + let lineOnly = + (Map.empty, directives) + ||> Seq.fold (fun acc d -> + let add line = + let existing = Map.tryFind line acc |> Option.defaultValue [] + Map.add line (d :: existing) acc + + match d.Kind with + | DisableLine -> add d.Line + | DisableNextLine -> add (d.Line + 1) + | Disable + | Enable -> acc + ) + + let blockDirectivesByLine = + directives + |> Seq.filter (fun d -> + match d.Kind with + | Disable + | Enable -> true + | DisableLine + | DisableNextLine -> false + ) + |> Seq.groupBy (fun d -> d.Line) + |> Seq.map (fun (line, ds) -> line, List.ofSeq ds) + |> Map.ofSeq + + // Filling this with hundreds/thousands of NoneDisabled is nearly free: F# compiles a + // nullary DU case to a singleton, so every slot is a pointer to the same object. + let blockAtLine = Array.create lines.Length NoneDisabled + let mutable current = NoneDisabled + + for lineNo in 1 .. lines.Length do + match Map.tryFind lineNo blockDirectivesByLine with + | Some ds -> + for d in ds do + current <- transition current d + | None -> () + + blockAtLine[lineNo - 1] <- current + + { + Directives = Seq.toArray directives + LineOnly = lineOnly + BlockAtLine = blockAtLine + ParseDiagnostics = List.ofSeq parseDiagnostics + } + +/// Scans the given source text for `fable-disable*`/`fable-enable*` comments and builds a +/// queryable `FileSuppressions` snapshot. Meant to be computed once per file and cached. +/// +/// `defines` must be the same conditional-compilation symbols FCS was given (`FABLE_COMPILER`, +/// the project's `DefineConstants`, ...). Without them the tokenizer reports everything inside +/// an `#if` block as inactive code rather than comments, so directives sitting next to the very +/// warnings they're meant to suppress would be invisible. +let compute (defines: string list) (source: string) : FileSuppressions = + if mayContainDirectives source then + computeDirectives defines source + else + FileSuppressions.Empty + +/// Suppression snapshots shared by every file of a project: computing them is per-file work, but +/// warnings can point at any file (inlined calls) and files compile in parallel. Keyed by the +/// content hash `SourceReader` already returns, so a file edited under watch mode recomputes +/// instead of being scanned against stale text. +type private Cache() = + let entries = ConcurrentDictionary() + + /// May throw `KeyNotFoundException` for a file outside the project (e.g. the source of a + /// precompiled dll) - that's the caller's cue that there's nothing to suppress with. + member _.GetOrCompute(fileName: string, defines: string list, read: SourceReader) = + let hash, source = read fileName + + // GetOrAdd rather than a TryGetValue/assign pair: two threads racing on the same file + // would otherwise end up with separate snapshots, splitting the "directive was used" + // flags between them and producing bogus unused-directive reports. + let cachedHash, suppressions = + entries.GetOrAdd(fileName, fun _ -> hash, compute defines source.Value) + + if cachedHash = hash then + suppressions + else + // The file changed under us, so the snapshot is against the wrong text. + let fresh = hash, compute defines source.Value + entries[fileName] <- fresh + snd fresh + +/// Extracts the conditional-compilation symbols out of the option list FCS is given +/// (`FSharpProjectOptions.OtherOptions`), which is the only place the project's `DefineConstants` +/// and Fable's own `FABLE_COMPILER*` symbols are both present. +let definesFromCompilerOptions (otherOptions: string seq) = + otherOptions + |> Seq.choose (fun opt -> + if opt.StartsWith("--define:", System.StringComparison.Ordinal) then + Some(opt.Substring("--define:".Length)) + else + None + ) + |> List.ofSeq + +/// Project-wide entry point: resolves a file name to its suppressions, computing and caching on +/// first use. One instance per compiled project - it is shared across the per-file compilers. +type Resolver(defines: string list, read: SourceReader) = + let cache = Cache() + + static member FromCompilerOptions(otherOptions: string seq, read: SourceReader) = + Resolver(definesFromCompilerOptions otherOptions, read) + + member _.For(fileName: string) = + try + cache.GetOrCompute(fileName, defines, read) + with :? System.Collections.Generic.KeyNotFoundException -> + // Not a file of this project (e.g. the source of a precompiled dll): nothing to read, + // so nothing can be suppressed. Any other failure is a real problem and must surface. + FileSuppressions.Empty + + /// The directive problems of the given files. These are `FABLE0001`-band codes and so are + /// never themselves suppressible - they flag comment text that is wrong to keep, so the only + /// correct answer is to edit it. Call once the whole compilation is over: a warning raised + /// while compiling one file can be suppressed by a directive living in another. + member this.GetDiagnostics(fileNames: string seq) = + fileNames + |> Seq.collect (fun fileName -> this.For(fileName).GetDiagnostics() |> List.map (fun d -> fileName, d)) + |> List.ofSeq diff --git a/src/Fable.Transforms/Php/Fable2Php.fs b/src/Fable.Transforms/Php/Fable2Php.fs index 4afbb5ee5..2aa0c1970 100644 --- a/src/Fable.Transforms/Php/Fable2Php.fs +++ b/src/Fable.Transforms/Php/Fable2Php.fs @@ -2138,8 +2138,8 @@ type PhpCompiler(com: Fable.Compiler) = member this.WillPrecompileInlineFunction(file) = com.WillPrecompileInlineFunction(file) - member this.AddLog(msg, severity, rang, fileName, tag) = - com.AddLog(msg, severity, ?range = rang, ?fileName = fileName, ?tag = tag) + member this.AddLog(msg, severity, rang, fileName, tag, code) = + com.AddLog(msg, severity, ?range = rang, ?fileName = fileName, ?tag = tag, ?code = code) member this.AddWatchDependency(file) = com.AddWatchDependency(file) diff --git a/src/Fable.Transforms/Python/PythonCompiler.fs b/src/Fable.Transforms/Python/PythonCompiler.fs index 63563c02b..7430a9a1e 100644 --- a/src/Fable.Transforms/Python/PythonCompiler.fs +++ b/src/Fable.Transforms/Python/PythonCompiler.fs @@ -137,8 +137,8 @@ type PythonCompiler(com: Compiler) = member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string) = - com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag) + member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string, ?code: string) = + com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag, ?code = code) let makeCompiler com = PythonCompiler(com) diff --git a/src/Fable.Transforms/Python/Replacements.fs b/src/Fable.Transforms/Python/Replacements.fs index 5676b8c46..e74a6455d 100644 --- a/src/Fable.Transforms/Python/Replacements.fs +++ b/src/Fable.Transforms/Python/Replacements.fs @@ -1512,7 +1512,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt Helper.LibCall(com, "string", "starts_with", t, args, i.SignatureArgTypes, thisArg = c, ?loc = r) |> Some | "StartsWith", Some c, [ value; ignoreCase; _culture ] -> - addWarning com ctx.InlinePath r "CultureInfo argument is ignored" + WarningCodes.cultureInfoIgnored |> addWarningWithCode com ctx.InlinePath r let args = [ value; ignoreCase ] Helper.LibCall(com, "string", "starts_with", t, args, i.SignatureArgTypes, thisArg = c, ?loc = r) @@ -1524,7 +1524,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt Helper.LibCall(com, "string", "ends_with", t, args, i.SignatureArgTypes, thisArg = c, ?loc = r) |> Some | "EndsWith", Some c, [ value; ignoreCase; _culture ] -> - addWarning com ctx.InlinePath r "CultureInfo argument is ignored" + WarningCodes.cultureInfoIgnored |> addWarningWithCode com ctx.InlinePath r let args = [ value; ignoreCase ] Helper.LibCall(com, "string", "ends_with", t, args, i.SignatureArgTypes, thisArg = c, ?loc = r) @@ -2322,8 +2322,8 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let intConst = int System.Globalization.NumberStyles.Integer if style <> hexConst && style <> intConst then - $"%s{i.DeclaringEntityFullName}.%s{meth}(): NumberStyle %d{style} is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.numberStylesIgnored style + |> addWarningWithCode com ctx.InlinePath r let acceptedArgs = if meth = "Parse" then @@ -2331,10 +2331,13 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op else 3 - if List.length args > acceptedArgs then + match List.tryItem acceptedArgs args with + // InvariantCulture asks for exactly what Fable does, so there is nothing to report. + | None + | Some InvariantCulture -> () + | Some _ -> // e.g. Double.Parse(string, style, IFormatProvider) etc. - $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r parseCall meth str args style | ("Parse" | "TryParse") as meth, str :: _ -> @@ -2344,10 +2347,13 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op else 2 - if List.length args > acceptedArgs then + match List.tryItem acceptedArgs args with + // InvariantCulture asks for exactly what Fable does, so there is nothing to report. + | None + | Some InvariantCulture -> () + | Some _ -> // e.g. Double.Parse(string, IFormatProvider) etc. - $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r let style = int System.Globalization.NumberStyles.Any parseCall meth str args style @@ -2927,8 +2933,7 @@ let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) ( | "ToBase64String" | "FromBase64String" -> if not (List.isSingle args) then - $"Convert.%s{Naming.upperFirst i.CompiledName} only accepts one single argument" - |> addWarning com ctx.InlinePath r + WarningCodes.base64ArgumentsIgnored |> addWarningWithCode com ctx.InlinePath r Helper.LibCall(com, "String", (Naming.lowerFirst i.CompiledName), t, args, i.SignatureArgTypes, ?loc = r) |> Some @@ -2991,24 +2996,35 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio IfThenElse(arg, makeDebugger r, unit, r) |> Some | _ -> None -let private ignoreFormatProvider com (ctx: Context) r (moduleName: string) meth args = - match meth, args with - // Ignore IFormatProvider - | "Parse", arg :: _culture :: _styles :: _ -> - addWarning com ctx.InlinePath r $"%s{moduleName}.Parse will ignore culture and styles" +/// Drops the `IFormatProvider` (and `DateTimeStyles`, where present) a date/time `Parse` was +/// given, warning once per discarded argument. Two codes rather than one bundled message so a +/// user who accepts invariant parsing can still be told about a discarded style, and vice versa. +let private ignoreFormatProvider com (ctx: Context) r meth args = + // Passing InvariantCulture asks for exactly what Fable does, so there is nothing to report. + let warnProvider culture = + match culture with + | InvariantCulture -> () + | _ -> WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r + + let warnStyles styles = + match styles with + | NumberConst(NumberValue.Int32 0, _) -> () // DateTimeStyles.None: no special handling + | _ -> WarningCodes.dateTimeStylesIgnored |> addWarningWithCode com ctx.InlinePath r + match meth, args with + | "Parse", arg :: culture :: styles :: _ -> + warnProvider culture + warnStyles styles [ arg ] - | "Parse", arg :: _culture :: _ -> - addWarning com ctx.InlinePath r $"%s{moduleName}.Parse will ignore culture" - + | "Parse", arg :: culture :: _ -> + warnProvider culture [ arg ] - | "TryParse", input :: _culture :: _styles :: defVal :: _ -> - addWarning com ctx.InlinePath r $"%s{moduleName}.TryParse will ignore culture and styles" - + | "TryParse", input :: culture :: styles :: defVal :: _ -> + warnProvider culture + warnStyles styles [ input; defVal ] - | "TryParse", input :: _culture :: defVal :: _ -> - addWarning com ctx.InlinePath r $"%s{moduleName}.TryParse will ignore culture" - + | "TryParse", input :: culture :: defVal :: _ -> + warnProvider culture [ input; defVal ] | _ -> args @@ -3059,7 +3075,7 @@ let dateOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op Helper.LibCall(com, "DateOnly", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) |> Some | meth -> - let args = ignoreFormatProvider com ctx r i.DeclaringEntityFullName meth args + let args = ignoreFormatProvider com ctx r meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst Helper.LibCall(com, "DateOnly", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -3116,7 +3132,7 @@ let timeOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op |> Some | _ -> None | meth -> - let args = ignoreFormatProvider com ctx r i.DeclaringEntityFullName meth args + let args = ignoreFormatProvider com ctx r meth args let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst Helper.LibCall(com, "TimeOnly", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -3258,8 +3274,7 @@ let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio Helper.LibCall(com, "DateOffset", "compareTo", t, [ thisArg; args.Head ], ?loc = r) ) | "TryParse" -> - let args = - ignoreFormatProvider com ctx r i.DeclaringEntityFullName i.CompiledName args + let args = ignoreFormatProvider com ctx r i.CompiledName args Helper.LibCall(com, moduleName, "tryParse", t, args, i.SignatureArgTypes, ?loc = r) |> Some @@ -3286,7 +3301,7 @@ let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio |> Some | _ -> None | meth -> - let args = ignoreFormatProvider com ctx r i.DeclaringEntityFullName meth args + let args = ignoreFormatProvider com ctx r meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst Helper.LibCall(com, moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) diff --git a/src/Fable.Transforms/Replacements.Util.fs b/src/Fable.Transforms/Replacements.Util.fs index ef005149e..dda1c336a 100644 --- a/src/Fable.Transforms/Replacements.Util.fs +++ b/src/Fable.Transforms/Replacements.Util.fs @@ -901,6 +901,15 @@ let (|ArrayOrListLiteral|_|) = | MaybeCasted(Value((NewArray(ArrayValues vals, t, _) | ListLiteral(vals, t)), _)) -> ValueSome(vals, t) | _ -> ValueNone +/// `CultureInfo.InvariantCulture`, which every target replaces with an empty object literal (see +/// `globalization`). Matching it keeps "culture is ignored" warnings quiet when the culture asked +/// for is the one Fable uses anyway. +[] +let (|InvariantCulture|_|) = + function + | MaybeCasted(ObjectExpr([], DeclaredType(entRef, _), None)) when entRef.FullName = Types.cultureInfo -> ValueSome() + | _ -> ValueNone + [] let (|IsEntity|_|) fullName = function diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index aef89aa1e..0b9dc784f 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -1723,7 +1723,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt Helper.LibCall(com, "String", "startsWith", t, args, i.SignatureArgTypes, thisArg = c, ?loc = r) |> Some | "StartsWith", Some c, [ value; ignoreCase; _culture ] -> - addWarning com ctx.InlinePath r "CultureInfo argument is ignored" + WarningCodes.cultureInfoIgnored |> addWarningWithCode com ctx.InlinePath r let args = [ value; ignoreCase ] Helper.LibCall(com, "String", "startsWith", t, args, i.SignatureArgTypes, thisArg = c, ?loc = r) @@ -1733,7 +1733,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt Helper.LibCall(com, "String", "endsWith", t, args, i.SignatureArgTypes, thisArg = c, ?loc = r) |> Some | "EndsWith", Some c, [ value; ignoreCase; _culture ] -> - addWarning com ctx.InlinePath r "CultureInfo argument is ignored" + WarningCodes.cultureInfoIgnored |> addWarningWithCode com ctx.InlinePath r let args = [ value; ignoreCase ] Helper.LibCall(com, "String", "endsWith", t, args, i.SignatureArgTypes, thisArg = c, ?loc = r) @@ -2635,8 +2635,8 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let intConst = int System.Globalization.NumberStyles.Integer if style <> hexConst && style <> intConst then - $"%s{i.DeclaringEntityFullName}.%s{meth}(): NumberStyle %d{style} is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.numberStylesIgnored style + |> addWarningWithCode com ctx.InlinePath r let acceptedArgs = if meth = "Parse" then @@ -2644,10 +2644,13 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op else 3 - if List.length args > acceptedArgs then + match List.tryItem acceptedArgs args with + // InvariantCulture asks for exactly what Fable does, so there is nothing to report. + | None + | Some InvariantCulture -> () + | Some _ -> // e.g. Double.Parse(string, style, IFormatProvider) etc. - $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r parseCall meth str args style |> Some | ("Parse" | "TryParse") as meth, str :: _ -> @@ -2657,10 +2660,13 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op else 2 - if List.length args > acceptedArgs then + match List.tryItem acceptedArgs args with + // InvariantCulture asks for exactly what Fable does, so there is nothing to report. + | None + | Some InvariantCulture -> () + | Some _ -> // e.g. Double.Parse(string, IFormatProvider) etc. - $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r let style = int System.Globalization.NumberStyles.Any parseCall meth str args style |> Some @@ -3199,8 +3205,7 @@ let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) ( | "ToBase64String" | "FromBase64String" -> if not (List.isSingle args) then - $"Convert.%s{Naming.upperFirst i.CompiledName} only accepts one single argument" - |> addWarning com ctx.InlinePath r + WarningCodes.base64ArgumentsIgnored |> addWarningWithCode com ctx.InlinePath r Helper.LibCall(com, "String", (Naming.lowerFirst i.CompiledName), t, args, i.SignatureArgTypes, ?loc = r) |> Some @@ -3243,12 +3248,37 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio IfThenElse(cond, makeDebugger r, unit, r) |> Some | _ -> None -let ignoreFormatProvider meth args = +/// Drops the `IFormatProvider` (and `DateTimeStyles`, where present) a date/time `Parse` was +/// given, warning once per discarded argument. `Parse arg` with no extra argument discards +/// nothing, so it must not warn. +let ignoreFormatProvider com (ctx: Context) r meth args = + // Passing InvariantCulture asks for exactly what Fable does, so there is nothing to report. + let warnProvider culture = + match culture with + | InvariantCulture -> () + | _ -> WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r + + let warnStyles styles = + match styles with + | NumberConst(NumberValue.Int32 0, _) -> () // DateTimeStyles.None: no special handling + | _ -> WarningCodes.dateTimeStylesIgnored |> addWarningWithCode com ctx.InlinePath r + match meth, args with - // Ignore IFormatProvider + | "Parse", arg :: culture :: styles :: _ -> + warnProvider culture + warnStyles styles + [ arg ] + | "Parse", arg :: culture :: _ -> + warnProvider culture + [ arg ] | "Parse", arg :: _ -> [ arg ] - | "TryParse", input :: _culture :: _styles :: defVal :: _ -> [ input; defVal ] - | "TryParse", input :: _culture :: defVal :: _ -> [ input; defVal ] + | "TryParse", input :: culture :: styles :: defVal :: _ -> + warnProvider culture + warnStyles styles + [ input; defVal ] + | "TryParse", input :: culture :: defVal :: _ -> + warnProvider culture + [ input; defVal ] | _ -> args let dateTime (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -3298,7 +3328,7 @@ let dateTime (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op Helper.LibCall(com, "Date", "getTicks", t, [ thisArg.Value ], [ thisArg.Value.Type ], ?loc = r) |> Some | meth -> - let args = ignoreFormatProvider meth args + let args = ignoreFormatProvider com ctx r meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst Helper.LibCall(com, moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -3364,7 +3394,7 @@ let dateTimeOffset (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: E Helper.LibCall(com, "DateOffset", "getUtcTicks", t, [ thisArg.Value ], [ thisArg.Value.Type ], ?loc = r) |> Some | meth -> - let args = ignoreFormatProvider meth args + let args = ignoreFormatProvider com ctx r meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst Helper.LibCall(com, moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -3418,7 +3448,7 @@ let dateOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op Helper.LibCall(com, "Date", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) |> Some | meth -> - let args = ignoreFormatProvider meth args + let args = ignoreFormatProvider com ctx r meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst Helper.LibCall(com, "DateOnly", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -3426,7 +3456,7 @@ let dateOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let timeSpans (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = let timeSpanLibCall meth args = - let args = ignoreFormatProvider meth args + let args = ignoreFormatProvider com ctx r meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst Helper.LibCall(com, "TimeSpan", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -3440,11 +3470,7 @@ let timeSpans (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg let limitArgsCountToMilliseconds (meth: string) (maxArgsCount: int) = if args.Length > maxArgsCount then if isNotDefaultInt64ZeroValue args.[maxArgsCount] then - addWarning - com - ctx.InlinePath - r - "TimeSpan precision is limited to milliseconds, microsecond arguments will be ignored" + WarningCodes.timeSpanPrecisionIgnored |> addWarningWithCode com ctx.InlinePath r args |> List.take maxArgsCount |> timeSpanLibCall meth @@ -3540,7 +3566,7 @@ let timeOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op |> Some | _ -> None | meth -> - let args = ignoreFormatProvider meth args + let args = ignoreFormatProvider com ctx r meth args let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst Helper.LibCall(com, "TimeOnly", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -4340,6 +4366,10 @@ let fsharpType com (ctx: Context) methName (r: SourceLocation option) t (i: Call // Prevent name clash with FSharpValue.GetRecordFields | "GetRecordFields" -> // Drop the trailing `allowAccessToPrivateRepresentation` flag (no meaning in JS/TS) + if List.length args > 1 then + WarningCodes.privateRepresentationFlagIgnored + |> addWarningWithCode com ctx.InlinePath r + Helper.LibCall(com, "Reflection", "getRecordElements", t, List.truncate 1 args, i.SignatureArgTypes, ?loc = r) |> Some | "GetUnionCases" @@ -4350,8 +4380,8 @@ let fsharpType com (ctx: Context) methName (r: SourceLocation option) t (i: Call | "IsTuple" | "IsFunction" -> if List.length args > 1 then - $"FSharpType.%s{methName}(): second argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.privateRepresentationFlagIgnored + |> addWarningWithCode com ctx.InlinePath r let args = [ List.head args ] diff --git a/src/Fable.Transforms/Rust/Fable2Rust.fs b/src/Fable.Transforms/Rust/Fable2Rust.fs index 58aeba693..f5f846c6d 100644 --- a/src/Fable.Transforms/Rust/Fable2Rust.fs +++ b/src/Fable.Transforms/Rust/Fable2Rust.fs @@ -5735,8 +5735,8 @@ module Compiler = member _.GetInlineExpr(fullName) = com.GetInlineExpr(fullName) member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string) = - com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag) + member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string, ?code: string) = + com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag, ?code = code) let makeCompiler com = RustCompiler(com) diff --git a/src/Fable.Transforms/Rust/Replacements.fs b/src/Fable.Transforms/Rust/Replacements.fs index fba43b41c..8277b52a2 100644 --- a/src/Fable.Transforms/Rust/Replacements.fs +++ b/src/Fable.Transforms/Rust/Replacements.fs @@ -1482,8 +1482,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt match args with | (ExprType String :: _) -> "sprintf!" |> emitFormat com r t args |> Some | (cultureInfo :: restArgs) -> - $"String.Format(): Format provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r "sprintf!" |> emitFormat com r t restArgs |> Some | _ -> None @@ -1698,8 +1697,7 @@ let stringBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Ex Helper.LibCall(com, "Util", "sb_Append", t, [ sb; s ], ?loc = r) |> Some | (cultureInfo :: restArgs) -> - $"StringBuilder.AppendFormat(): Format provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r let s = "sprintf!" |> emitFormat com None String restArgs @@ -2171,8 +2169,8 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let intConst = int System.Globalization.NumberStyles.Integer if style <> hexConst && style <> intConst then - $"%s{i.DeclaringEntityFullName}.%s{meth}(): NumberStyle %d{style} is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.numberStylesIgnored style + |> addWarningWithCode com ctx.InlinePath r let acceptedArgs = if meth = "Parse" then @@ -2180,10 +2178,13 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op else 3 - if List.length args > acceptedArgs then + match List.tryItem acceptedArgs args with + // InvariantCulture asks for exactly what Fable does, so there is nothing to report. + | None + | Some InvariantCulture -> () + | Some _ -> // e.g. Double.Parse(string, style, IFormatProvider) etc. - $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r parseCall meth str args style |> Some | ("Parse" | "TryParse") as meth, str :: _ -> @@ -2193,10 +2194,13 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op else 2 - if List.length args > acceptedArgs then + match List.tryItem acceptedArgs args with + // InvariantCulture asks for exactly what Fable does, so there is nothing to report. + | None + | Some InvariantCulture -> () + | Some _ -> // e.g. Double.Parse(string, IFormatProvider) etc. - $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" - |> addWarning com ctx.InlinePath r + WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r let style = int System.Globalization.NumberStyles.Any parseCall meth str args style |> Some @@ -2616,19 +2620,44 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | _ -> None | _ -> None -let ignoreFormatProvider compiledName args = +/// Drops the `IFormatProvider` (and `DateTimeStyles`, where present) a date/time `Parse` was +/// given, warning once per discarded argument. `Parse arg` with no extra argument discards +/// nothing, so it must not warn. `ToString` stays silent here, as it does on every other target. +let ignoreFormatProvider com (ctx: Context) r compiledName args = + // Passing InvariantCulture asks for exactly what Fable does, so there is nothing to report. + let warnProvider culture = + match culture with + | InvariantCulture -> () + | _ -> WarningCodes.formatProviderIgnored |> addWarningWithCode com ctx.InlinePath r + + let warnStyles styles = + match styles with + | NumberConst(NumberValue.Int32 0, _) -> () // DateTimeStyles.None: no special handling + | _ -> WarningCodes.dateTimeStylesIgnored |> addWarningWithCode com ctx.InlinePath r + match compiledName, args with - // Ignore IFormatProvider | "ToString", ExprTypeAs(String, arg) :: _ -> [ arg ] | "ToString", _ -> [ makeStrConst "" ] // default (no format string) + | "Parse", arg :: culture :: styles :: _ -> + warnProvider culture + warnStyles styles + [ arg ] + | "Parse", arg :: culture :: _ -> + warnProvider culture + [ arg ] | "Parse", arg :: _ -> [ arg ] - | "TryParse", input :: _culture :: _styles :: defVal :: _ -> [ input; defVal ] - | "TryParse", input :: _culture :: defVal :: _ -> [ input; defVal ] + | "TryParse", input :: culture :: styles :: defVal :: _ -> + warnProvider culture + warnStyles styles + [ input; defVal ] + | "TryParse", input :: culture :: defVal :: _ -> + warnProvider culture + [ input; defVal ] | _ -> args let makeMemberCall com ctx r t i moduleName memberName (thisArg: Expr option) (args: Expr list) = let memberName = Naming.removeGetSetPrefix memberName |> Naming.lowerFirst - let args = ignoreFormatProvider i.CompiledName args + let args = ignoreFormatProvider com ctx r i.CompiledName args match thisArg with | Some callee -> makeInstanceCall r t i callee memberName args diff --git a/src/Fable.Transforms/State.fs b/src/Fable.Transforms/State.fs index 65672dec4..0cd2923ec 100644 --- a/src/Fable.Transforms/State.fs +++ b/src/Fable.Transforms/State.fs @@ -257,15 +257,17 @@ type LogEntry = Severity: Severity Range: SourceLocation option FileName: string option + Code: string option } - static member Make(severity, msg, ?fileName, ?range, ?tag) = + static member Make(severity, msg, ?fileName, ?range, ?tag, ?code) = { Message = msg Tag = defaultArg tag "FABLE" Severity = severity Range = range FileName = fileName + Code = code } static member MakeError(msg, ?fileName, ?range, ?tag) = @@ -283,7 +285,8 @@ type CompilerImpl ?outDir: string, ?watchDependencies: HashSet, ?logs: ResizeArray, - ?isPrecompilingInlineFunction: bool + ?isPrecompilingInlineFunction: bool, + ?warningSuppression: WarningSuppression.Resolver ) = @@ -292,6 +295,11 @@ type CompilerImpl let logs = Option.defaultWith ResizeArray logs let fableLibraryDir = fableLibDir.TrimEnd('/') + let getSuppressions fileName = + match warningSuppression with + | Some resolver -> resolver.For(fileName) + | None -> WarningSuppression.FileSuppressions.Empty + member _.Logs = logs.ToArray() member _.WatchDependencies = @@ -333,7 +341,8 @@ type CompilerImpl ?outDir = outDir, ?watchDependencies = watchDependencies, logs = logs, - isPrecompilingInlineFunction = true + isPrecompilingInlineFunction = true, + ?warningSuppression = warningSuppression ) member _.GetImplementationFile(fileName) = @@ -387,6 +396,29 @@ type CompilerImpl | Some watchDependencies when file <> currentFile -> watchDependencies.Add(file) |> ignore | _ -> () - member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string) = - LogEntry.Make(severity, msg, ?range = range, ?fileName = fileName, ?tag = tag) - |> logs.Add + member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string, ?code: string) = + // Only warnings can be suppressed, errors always surface (matches F#'s own #nowarn), + // and neither can the warnings about the `fable-disable` directives themselves. + let isSuppressed = + severity = Severity.Warning + && WarningCodes.isSuppressible code + && ( + match range with + | None -> false + | Some(r: SourceLocation) -> + let file = + match fileName with + | Some f -> f + | None -> + match r.File with + | Some f -> f + | None -> currentFile + + // The whole range, not just its first line, so a trailing + // `// fable-disable-line` still works on a multi-line expression. + (getSuppressions file).IsSuppressed(r.start.line, r.``end``.line, code) + ) + + if not isSuppressed then + LogEntry.Make(severity, msg, ?range = range, ?fileName = fileName, ?tag = tag, ?code = code) + |> logs.Add diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index c5cc988a7..9d9f1d5af 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -228,6 +228,9 @@ module Types = [] let timeOnly = "System.TimeOnly" + [] + let cultureInfo = "System.Globalization.CultureInfo" + [] let timer = "System.Timers.Timer" @@ -668,7 +671,14 @@ module Log = FromRange: SourceLocation option } - let private addLog (com: Compiler) (inlinePath: InlinePath list) (range: SourceLocation option) msg severity = + let private addLogWithCode + (com: Compiler) + (inlinePath: InlinePath list) + (range: SourceLocation option) + msg + severity + (code: string option) + = let printInlineSource fromPath (p: InlinePath) = let path = Path.getRelativeFileOrDirPath false fromPath false p.FromFile @@ -685,11 +695,22 @@ module Log = file, msg + " - Inline call from " + inlinePath | [] -> range |> Option.bind (fun r -> r.File) |> Option.defaultValue com.CurrentFile, msg - com.AddLog(msg, severity, ?range = range, fileName = actualFile) + com.AddLog(msg, severity, ?range = range, fileName = actualFile, ?code = code) + + let private addLog (com: Compiler) (inlinePath: InlinePath list) (range: SourceLocation option) msg severity = + addLogWithCode com inlinePath range msg severity None let addWarning (com: Compiler) inlinePath range warning = addLog com inlinePath range warning Severity.Warning + /// Same as `addWarning`, but tags the warning with a stable code (e.g. "FABLE0001") so it + /// can be suppressed via `// fable-disable-line/-next-line/-enable CODE` comments. + /// Meant to be used as `WarningCodes.someWarning arg1 arg2 |> addWarningWithCode com inlinePath range`. + /// + /// Note that a warning coming out of an inlined function is attributed to the file that *defines* it + let addWarningWithCode (com: Compiler) inlinePath range ((code, warning): string * string) = + addLogWithCode com inlinePath range warning Severity.Warning (Some code) + let addError (com: Compiler) inlinePath range error = addLog com inlinePath range error Severity.Error diff --git a/src/fable-standalone/src/Fable.Standalone.fsproj b/src/fable-standalone/src/Fable.Standalone.fsproj index 64ac4fa02..6daecdaa9 100644 --- a/src/fable-standalone/src/Fable.Standalone.fsproj +++ b/src/fable-standalone/src/Fable.Standalone.fsproj @@ -22,6 +22,8 @@ + + diff --git a/src/fable-standalone/src/Main.fs b/src/fable-standalone/src/Main.fs index 1504c64b4..8c0043de1 100644 --- a/src/fable-standalone/src/Main.fs +++ b/src/fable-standalone/src/Main.fs @@ -152,6 +152,7 @@ let makeCompiler fableLibrary typedArrays language fsharpOptions project fileNam ?typedArrays = typedArrays ) + // No `warningSuppression`: the REPL has no `SourceReader` to scan, so `// fable-disable` comments are a no-op here. CompilerImpl(fileName, project, options, fableLibrary) let makeProject (projectOptions: FSharpProjectOptions) (checkResults: FSharpCheckProjectResults) = diff --git a/tests/Integration/Compiler/CompilerHelpersTests.fs b/tests/Integration/Compiler/CompilerHelpersTests.fs index 5b4bd5dfa..a3a2bfa39 100644 --- a/tests/Integration/Compiler/CompilerHelpersTests.fs +++ b/tests/Integration/Compiler/CompilerHelpersTests.fs @@ -5,8 +5,69 @@ open Util.Testing open Fable.Tests.Compiler.Util open Fable.Tests.Compiler.Util.Compiler +open System +open System.Reflection +open Fable.Transforms + +/// Every warning code `WarningCodes` can emit, read from the module itself so that this test +/// has no list of its own to fall out of date. +let private codesTheRegistryCanProduce () = + let flags = BindingFlags.Public ||| BindingFlags.Static + let moduleType = typeof.Assembly.GetType("Fable.Transforms.WarningCodes") + let codeOf (pair: obj) = fst (pair :?> string * string) + + // The parameterised warnings interpolate their argument into the message, never into the + // code, so anything of the right type will do. + let throwaway (p: ParameterInfo) = + if p.ParameterType = typeof then box "" + elif p.ParameterType.IsValueType then Activator.CreateInstance p.ParameterType + else null + + // A warning is anything shaped `string * string`: plain ones compile to static properties, + // parameterised ones to static methods. Nothing else in the module has that shape. + let fromValues = + moduleType.GetProperties(flags) + |> Array.filter (fun p -> p.PropertyType = typeof) + |> Array.map (fun p -> codeOf (p.GetValue(null))) + + let fromFactories = + moduleType.GetMethods(flags) + |> Array.filter (fun m -> not m.IsSpecialName && m.ReturnType = typeof) + |> Array.map (fun m -> codeOf (m.Invoke(null, m.GetParameters() |> Array.map throwaway))) + + Set.ofArray (Array.append fromValues fromFactories) + let tests = testList "Compiler Helpers" [ + // The goal of this test is to act as a safe guard for us, so we remember to add + // warning code to the knownCodes list. + testCase "knownCodes lists every warning the registry can produce" <| fun _ -> + // Forgetting to add a code is otherwise silent until somebody writes a directive for + // it and gets told it's a typo - the one thing knownCodes exists to prevent. + let produced = codesTheRegistryCanProduce () + + // Guards against the reflection above quietly finding nothing, which would make every + // assertion below pass for the wrong reason. + if Set.isEmpty produced then + failwith "Found no warnings in WarningCodes - the reflection in this test has gone stale" + + let missing = Set.difference produced WarningCodes.knownCodes + let stale = Set.difference WarningCodes.knownCodes produced + + if not (Set.isEmpty missing) || not (Set.isEmpty stale) then + failwithf "knownCodes is out of sync. Missing: %A. Listed but unused: %A" missing stale + + testCase "isSuppressible splits the code bands at FABLE0100" <| fun _ -> + // Directive warnings sit below the boundary and can never be silenced by a directive. + WarningCodes.isSuppressible (Some "FABLE0001") |> equal false + WarningCodes.isSuppressible (Some "FABLE0002") |> equal false + WarningCodes.isSuppressible (Some "FABLE0003") |> equal false + WarningCodes.isSuppressible (Some "FABLE0099") |> equal false + WarningCodes.isSuppressible (Some "FABLE0100") |> equal true + WarningCodes.isSuppressible (Some "FABLE9999") |> equal true + // A warning with no code at all is still caught by a bare `// fable-disable-line`. + WarningCodes.isSuppressible None |> equal true + testCase "expectedVersionMatchesActual works for same major version" <| fun _ -> Fable.CompilerExt.expectedVersionMatchesActual "5.0.0" "5.0.0" |> equal true Fable.CompilerExt.expectedVersionMatchesActual "5.0.0" "5.0.1" |> equal true diff --git a/tests/Integration/Compiler/CompilerMessagesTests.fs b/tests/Integration/Compiler/CompilerMessagesTests.fs index 24420f1bd..127cf4b8c 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -14,6 +14,7 @@ let tests = compile source |> Assert.Is.success |> ignore + testCase "Compile printfn" <| fun _ -> let source = "printfn \"Hello %s\" \"World\"" compile source @@ -25,6 +26,7 @@ let tests = compile source |> Assert.Is.Single.error |> ignore + testCase "Compiling incomplete pattern match results in warning" <| fun _ -> let source = "match None with | Some n -> 42 |> ignore" // without `ignore`: Warning: Result of Expression is implicitly ignored compile source @@ -36,6 +38,7 @@ let tests = compile source |> Assert.Exists.errorWith "This expression was expected to have type" |> ignore + testCase "Compiling incomplete pattern match results in specific warning" <| fun _ -> let source = "match None with | Some n -> 42" compile source @@ -125,4 +128,20 @@ type MyClass() = compile source |> Assert.Is.success |> ignore + + testCase "The formatted output carries the warning code" <| fun _ -> + // Without this there is no way to discover which code to put in a directive. + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +""" + let formatted = + compile source + |> List.filter (fun log -> log.Code = Some "FABLE0100") + |> List.map (Fable.Cli.Main.Util.formatLog Compiler.Cached.projDir) + + match formatted with + | [] -> failwith "Expected a FABLE0100 warning" + | messages -> equal true (messages |> List.forall (fun m -> m.Contains "warning FABLE FABLE0100:")) ] diff --git a/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj b/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj index 49253cae8..6098d46d3 100644 --- a/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj +++ b/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj @@ -23,6 +23,8 @@ + + diff --git a/tests/Integration/Compiler/IgnoredArgumentTests.fs b/tests/Integration/Compiler/IgnoredArgumentTests.fs new file mode 100644 index 000000000..a2af15784 --- /dev/null +++ b/tests/Integration/Compiler/IgnoredArgumentTests.fs @@ -0,0 +1,203 @@ +module Fable.Tests.Compiler.IgnoredArgument + +open Fable.Core +open Util.Testing +open Fable.Tests.Compiler.Util +open Fable.Tests.Compiler.Util.Compiler + +let private compile source = Compiler.Cached.compile Compiler.Settings.standard source + +(* + Verify that warnings are generated when needed, and skipped in the scenario where Fable + has the same behavior as .NET. + + The later makes the logs less verbose and warnings more meaningful +*) + +let tests = + testList "Ignored Arguments" [ + testCase "Discarding a format provider on a date parse is reported" <| fun _ -> + // JS, Dart and Rust used to drop this argument silently while Python warned. Aligning them + // is a behaviour change: code that compiled quietly now raises FABLE0102. + let source = + """ +open System +open System.Globalization +DateTime.Parse("2026-01-01", CultureInfo.GetCultureInfo "fr-FR") |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0102" + |> ignore + + testCase "Passing InvariantCulture to a parse is not reported" <| fun _ -> + // Fable parses with a fixed culture-independent implementation, so InvariantCulture asks + // for exactly what it gets. Warning here would fire on every correct call - and does, if + // the exemption is removed: 96 sites across the repo's own test suites. + let source = + """ +open System +open System.Globalization +DateTime.Parse("2026-01-01", CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0102" + |> ignore + + testCase "A discarded DateTimeStyles is reported even when the culture is exempt" <| fun _ -> + // Two codes rather than one bundled message: the style is still discarded regardless of + // which culture was passed, so exempting the culture must not silence it. + let source = + """ +open System +open System.Globalization +DateTime.Parse("2026-01-01", CultureInfo.InvariantCulture, DateTimeStyles.AssumeUniversal) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0104" + |> Assert.Code.noWarning "FABLE0102" + |> ignore + + testCase "DateTimeStyles.None is not reported" <| fun _ -> + // `None` means "no special handling", which is what Fable does - same exemption as + // InvariantCulture. Every one of the 12 sites in tests/Js passes exactly this. + let source = + """ +open System +open System.Globalization +DateTime.Parse("2026-01-01", CultureInfo.InvariantCulture, DateTimeStyles.None) |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0102" + |> Assert.Code.noWarning "FABLE0104" + |> ignore + + testCase "A numeric parse given InvariantCulture is not reported" <| fun _ -> + let source = + """ +open System +open System.Globalization +Double.Parse("10.5", CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0102" + |> ignore + + testCase "A numeric parse given a real culture is reported" <| fun _ -> + let source = + """ +open System +open System.Globalization +Double.Parse("10.5", CultureInfo.GetCultureInfo "fr-FR") |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0102" + |> ignore + + testCase "A real culture and a style are both reported" <| fun _ -> + let source = + """ +open System +open System.Globalization +DateTime.Parse("2026-01-01", CultureInfo.GetCultureInfo "fr-FR", DateTimeStyles.AssumeUniversal) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0102" + |> Assert.Code.warning "FABLE0104" + |> ignore + + testCase "A date parse with no extra argument discards nothing and is silent" <| fun _ -> + let source = + """ +open System +DateTime.Parse("2026-01-01") |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0102" + |> Assert.Code.noWarning "FABLE0104" + |> ignore + + testCase "A discarded NumberStyles is reported" <| fun _ -> + let source = + """ +open System +open System.Globalization +Double.Parse("1.5", NumberStyles.Currency, CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0103" + |> ignore + + testCase "A TimeSpan built with microseconds is reported" <| fun _ -> + // The runtime representation only carries milliseconds, so the finer component is dropped. + let source = + """ +open System +TimeSpan.FromMilliseconds(1L, 500L) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0105" + |> ignore + + testCase "A TimeSpan with no microseconds is silent" <| fun _ -> + let source = + """ +open System +TimeSpan.FromMilliseconds(1L, 0L) |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0105" + |> ignore + + testCase "A private-representation flag on FSharpType is reported" <| fun _ -> + let source = + """ +open Microsoft.FSharp.Reflection +FSharpType.IsUnion(typeof, true) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0106" + |> ignore + + testCase "A private-representation flag on GetRecordFields is reported" <| fun _ -> + // This one dropped the flag silently while its seven siblings warned, all in one function. + let source = + """ +open Microsoft.FSharp.Reflection +type R = { A: int } +FSharpType.GetRecordFields(typeof, true) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0106" + |> ignore + + testCase "FSharpType without the flag is silent" <| fun _ -> + let source = + """ +open Microsoft.FSharp.Reflection +FSharpType.IsUnion(typeof) |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0106" + |> ignore + + testCase "Base64 offset and length arguments are reported" <| fun _ -> + // The slice is silently encoded whole, so this is a wrong value rather than a formatting nit. + let source = + """ +open System +Convert.ToBase64String([| 1uy; 2uy; 3uy; 4uy |], 0, 2) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0107" + |> ignore + + testCase "Base64 with only the array is silent" <| fun _ -> + let source = + """ +open System +Convert.ToBase64String([| 1uy; 2uy; 3uy; 4uy |]) |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0107" + |> ignore + ] diff --git a/tests/Integration/Compiler/Main.fs b/tests/Integration/Compiler/Main.fs index 18c778cfa..d1453a762 100644 --- a/tests/Integration/Compiler/Main.fs +++ b/tests/Integration/Compiler/Main.fs @@ -6,6 +6,8 @@ open Expecto let allTests = [ CompilerMessages.tests + WarningSuppression.tests + IgnoredArgument.tests AnonRecordInInterface.tests CompilerHelpers.tests Inflate.tests diff --git a/tests/Integration/Compiler/Util/Compiler.fs b/tests/Integration/Compiler/Util/Compiler.fs index 4a6b62ffa..d42fafcdb 100644 --- a/tests/Integration/Compiler/Util/Compiler.fs +++ b/tests/Integration/Compiler/Util/Compiler.fs @@ -32,7 +32,9 @@ module Compiler = let sourceFile = IO.Path.Join(projDir, "Program.fs" ) |> Path.normalizeFullPath let cliArgs = - let compilerOptions = CompilerOptionsHelper.Make() + // The real CLI always defines these (Entry.fs), and code guarded by them is exactly where + // Fable warnings - and the comments suppressing them - live. + let compilerOptions = CompilerOptionsHelper.Make(define = ["FABLE_COMPILER"; "FABLE_COMPILER_JAVASCRIPT"]) { CliArgs.ProjectFile = projFile FableLibraryPath = None RootDir = projDir @@ -141,6 +143,8 @@ module Compiler = let errorOrWarning: Result -> bool = List.isEmpty >> not let matching = List.exists let withMsg (txt: string) = List.exists (fun m -> m.Message.Contains txt) + module Code = + let is (code: string) (msg: LogEntry) = msg.Code = Some code module Text = let contains (txt: string) msg = msg.Message.Contains(txt, StringComparison.InvariantCultureIgnoreCase) let isMatch (regex: System.Text.RegularExpressions.Regex) (msg: LogEntry) = @@ -205,6 +209,16 @@ module Compiler = Test.All.warning |> orFail expected.All.Warning + /// Assertions on the stable `FABLExxxx` codes rather than on message text: what a + /// `// fable-disable` comment targets is the code, so that's what the tests must pin. + module Code = + let warning (code: string) = + Test.Exists.matching (Test.Is.warning >&> Test.Code.is code) + |> orFail (expected.Warning.With code) + let noWarning (code: string) = + (not << Test.Exists.matching (Test.Is.warning >&> Test.Code.is code)) + |> orFail (expected.No.Warning.With code) + module Exists = let errorWith (txt: string) = Test.Exists.matching (Test.Is.error >&> Test.Text.contains txt) diff --git a/tests/Integration/Compiler/WarningSuppressionTests.fs b/tests/Integration/Compiler/WarningSuppressionTests.fs new file mode 100644 index 000000000..bda6ca3d3 --- /dev/null +++ b/tests/Integration/Compiler/WarningSuppressionTests.fs @@ -0,0 +1,322 @@ +module Fable.Tests.Compiler.WarningSuppression + +open Fable.Core +open Util.Testing +open Fable.Tests.Compiler.Util +open Fable.Tests.Compiler.Util.Compiler + +let private compile source = Compiler.Cached.compile Compiler.Settings.standard source + +/// Exercises the `// fable-disable` machinery itself - directive parsing, block scoping, which +/// warnings it can reach, and the FABLE0001-band reports about the directives. FABLE0100 stands +/// in as the subject warning throughout; what is under test is the mechanism, not that code. +let tests = + testList "Warning Suppression" [ + testCase "CultureInfo argument warning is not suppressed by default" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Exists.warningWith "CultureInfo argument is ignored" + |> ignore + + testCase "The same code covers both StartsWith and EndsWith call sites" <| fun _ -> + // StartsWith and EndsWith raise the same logical "CultureInfo argument is ignored" warning + // from two separate call sites in Replacements.fs, sharing WarningCodes.CultureInfoIgnored. + // One code must suppress both, otherwise the registry has failed at its only job. + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABLE0100 +"abc".EndsWith("c", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABLE0100 +""" + compile source + |> Assert.Are.warnings 0 + |> ignore + + testCase "fable-disable-line suppresses a warning on the same line" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABLE0100 +""" + compile source + |> Assert.Are.warnings 0 + |> ignore + + testCase "fable-disable-next-line suppresses a warning on the following line" <| fun _ -> + let source = + """ +open System.Globalization +// fable-disable-next-line FABLE0100 +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Are.warnings 0 + |> ignore + + testCase "fable-disable/fable-enable suppresses warnings in a block" <| fun _ -> + let source = + """ +open System.Globalization +// fable-disable FABLE0100 +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +"abc".EndsWith("c", true, CultureInfo.InvariantCulture) |> ignore +// fable-enable FABLE0100 +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Are.warnings 1 + |> ignore + + testCase "A mismatched code does not suppress the warning" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line SOME_OTHER_CODE +""" + compile source + |> Assert.Exists.warningWith "CultureInfo argument is ignored" + |> ignore + + testCase "A bare fable-disable-line suppresses regardless of code" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line +""" + compile source + |> Assert.Are.warnings 0 + |> ignore + + testCase "A string literal that looks like a directive is not treated as one" <| fun _ -> + let source = + """ +open System.Globalization +let s = "// fable-disable-line FABLE0100" +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Exists.warningWith "CultureInfo argument is ignored" + |> ignore + + testCase "A directive inside a #if FABLE_COMPILER block is honoured" <| fun _ -> + let source = + """ +open System.Globalization +#if FABLE_COMPILER +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABLE0100 +#endif +""" + compile source + |> Assert.Code.noWarning "FABLE0100" + |> ignore + + testCase "A warning inside a #if FABLE_COMPILER block still fires without a directive" <| fun _ -> + // Guards the test above from passing vacuously because the block was compiled out. + let source = + """ +open System.Globalization +#if FABLE_COMPILER +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +#endif +""" + compile source + |> Assert.Code.warning "FABLE0100" + |> ignore + + testCase "Errors are never suppressed, not even by a blanket fable-disable" <| fun _ -> + let source = + """ +open Fable.Core.JsInterop + +type Response = + abstract fn: int -> int + abstract prop: bool with get, set + +// fable-disable +let res = jsOptions (fun o -> o.fn <- (fun i -> i)) +""" + compile source + |> Assert.Exists.errorWith "Cannot set a non-property member in 'jsOptions'" + |> ignore + + testCase "A directive written as a block comment is honoured" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore (* fable-disable-line FABLE0100 *) +""" + compile source + |> Assert.Code.noWarning "FABLE0100" + |> ignore + + testCase "A trailing directive suppresses a warning spanning several lines" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith( + "a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABLE0100 +""" + compile source + |> Assert.Code.noWarning "FABLE0100" + |> ignore + + testCase "A fable-disable block with no fable-enable runs to the end of the file" <| fun _ -> + let source = + """ +open System.Globalization +// fable-disable FABLE0100 +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +"abc".EndsWith("c", true, CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0100" + |> ignore + + testCase "A colon separator and a lower-case code are accepted" <| fun _ -> + // What people coming from `# noqa: E501` and `@ts-ignore` will write. + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line: fable0100 +""" + compile source + |> Assert.Code.noWarning "FABLE0100" + |> ignore + + testCase "A justification after -- is not parsed as codes" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABLE0100 -- culture is irrelevant here +""" + compile source + |> Assert.Code.noWarning "FABLE0100" + |> Assert.Code.noWarning "FABLE0001" + |> ignore + + testCase "A typo'd code is reported instead of silently suppressing nothing" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABEL0001 +""" + compile source + |> Assert.Code.warning "FABLE0001" + |> Assert.Code.warning "FABLE0100" + // The typo report is the actionable one; don't pile "and it's unused" on top of it. + |> Assert.Code.noWarning "FABLE0002" + |> ignore + + testCase "A directive that suppresses nothing is reported as unused" <| fun _ -> + let source = + """ +open System.Globalization +// fable-disable-next-line FABLE0100 +let answer = 42 +""" + compile source + |> Assert.Code.warning "FABLE0002" + |> ignore + + testCase "A directive that does its job is not reported as unused" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABLE0100 +""" + compile source + |> Assert.Code.noWarning "FABLE0002" + |> ignore + + testCase "A fable-disable block with no codes is reported" <| fun _ -> + // It would otherwise silence every Fable warning to the end of the file, unnoticed. + let source = + """ +open System.Globalization +// fable-disable +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0003" + |> Assert.Code.noWarning "FABLE0100" + |> ignore + + testCase "Directive warnings cannot be suppressed by a directive" <| fun _ -> + // FABLE0001-0099 flag comment text that is wrong to keep, so the only correct answer is to + // edit it. Silencing "this directive is broken" with another directive is self-defeating. + let source = + """ +open System.Globalization +// fable-disable-next-line FABLE0002 +// fable-disable-next-line FABLE0100 +let answer = 42 +""" + compile source + |> Assert.Code.warning "FABLE0002" + |> ignore + + testCase "A blanket fable-disable cannot suppress its own report" <| fun _ -> + let source = + """ +open System.Globalization +// fable-disable +let answer = 42 +""" + compile source + |> Assert.Code.warning "FABLE0003" + |> ignore + + testCase "A word merely starting with a directive name is not a directive" <| fun _ -> + let source = + """ +open System.Globalization +"abc".StartsWith("a", true, CultureInfo.InvariantCulture) |> ignore // fable-disabled for now +""" + compile source + |> Assert.Code.warning "FABLE0100" + |> ignore + + testCase "Directives are found in CRLF sources" <| fun _ -> + let source = + [ "" + "open System.Globalization" + "\"abc\".StartsWith(\"a\", true, CultureInfo.InvariantCulture) |> ignore // fable-disable-line FABLE0100" + "" ] + |> String.concat "\r\n" + + compile source + |> Assert.Code.noWarning "FABLE0100" + |> ignore + + testCase "A warning from an inlined function is suppressed at its definition" <| fun _ -> + // The warning is attributed to the file the inline function is *defined* in, so that is + // where the directive has to go - the call site can't suppress it. + let source = + """ +open System.Globalization +let inline startsWithCulture (s: string) = + s.StartsWith("a", true, CultureInfo.InvariantCulture) // fable-disable-line FABLE0100 + +startsWithCulture "abc" |> ignore +""" + compile source + |> Assert.Code.noWarning "FABLE0100" + |> ignore + + testCase "A directive at the call site does not suppress an inlined function's warning" <| fun _ -> + let source = + """ +open System.Globalization +let inline startsWithCulture (s: string) = + s.StartsWith("a", true, CultureInfo.InvariantCulture) + +startsWithCulture "abc" |> ignore // fable-disable-line FABLE0100 +""" + compile source + |> Assert.Code.warning "FABLE0100" + |> ignore + ]