From 7eebb5fac72907a92afc9de8ad6e4b8b87a1fcf4 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Wed, 21 Oct 2026 21:50:22 +0200 Subject: [PATCH 1/2] feat(all): support // fable-disable warning comments --- src/Fable.Cli/Main.fs | 56 ++- src/Fable.Compiler/Library.fs | 19 +- src/Fable.Transforms/Babel/Fable2Babel.fs | 4 +- src/Fable.Transforms/Beam/Fable2Beam.fs | 4 +- src/Fable.Transforms/Dart/Fable2Dart.fs | 4 +- src/Fable.Transforms/Dart/Replacements.fs | 53 ++- src/Fable.Transforms/FSharp2Fable.fs | 4 +- src/Fable.Transforms/Fable.Transforms.fsproj | 2 + src/Fable.Transforms/Global/Compiler.fs | 3 +- src/Fable.Transforms/Global/WarningCodes.fs | 97 ++++ .../Global/WarningSuppression.fs | 437 ++++++++++++++++++ src/Fable.Transforms/Php/Fable2Php.fs | 4 +- src/Fable.Transforms/Python/PythonCompiler.fs | 4 +- src/Fable.Transforms/Python/Replacements.fs | 77 +-- src/Fable.Transforms/Replacements.Util.fs | 9 + src/Fable.Transforms/Replacements.fs | 86 ++-- src/Fable.Transforms/Rust/Fable2Rust.fs | 4 +- src/Fable.Transforms/Rust/Replacements.fs | 63 ++- src/Fable.Transforms/State.fs | 44 +- src/Fable.Transforms/Transforms.Util.fs | 28 +- .../src/Fable.Standalone.fsproj | 2 + src/fable-standalone/src/Main.fs | 1 + .../Compiler/CompilerHelpersTests.fs | 61 +++ .../Compiler/CompilerMessagesTests.fs | 19 + .../Compiler/Fable.Tests.Compiler.fsproj | 2 + .../Compiler/IgnoredArgumentTests.fs | 203 ++++++++ tests/Integration/Compiler/Main.fs | 2 + tests/Integration/Compiler/Util/Compiler.fs | 20 +- .../Compiler/WarningSuppressionTests.fs | 322 +++++++++++++ 29 files changed, 1512 insertions(+), 122 deletions(-) create mode 100644 src/Fable.Transforms/Global/WarningCodes.fs create mode 100644 src/Fable.Transforms/Global/WarningSuppression.fs create mode 100644 tests/Integration/Compiler/IgnoredArgumentTests.fs create mode 100644 tests/Integration/Compiler/WarningSuppressionTests.fs diff --git a/src/Fable.Cli/Main.fs b/src/Fable.Cli/Main.fs index 351d9ec0a3..d66ba6116f 100644 --- a/src/Fable.Cli/Main.fs +++ b/src/Fable.Cli/Main.fs @@ -16,7 +16,7 @@ open Fable.Compiler open Fable.Compiler.ProjectCracker open Fable.Compiler.Util -module private Util = +module Util = type PathResolver with static member Dummy = @@ -79,10 +79,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 @@ -353,6 +361,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 @@ -390,9 +410,32 @@ type ProjectCracked(cliArgs: CliArgs, crackerResponse: CrackerResponse, sourceFi crackerResponse.OutputType, ?outDir = cliArgs.OutDir, ?watchDependencies = watchDependencies, - ?signatureDependencies = signatureDependencies + ?signatureDependencies = signatureDependencies, + 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) @@ -1597,6 +1640,11 @@ let private compilationCycle (state: State) (changes: ISet) = Array.append logs [| log |], deps, sigDeps ) + // 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 64d0f0ebda..7d850edfa0 100644 --- a/src/Fable.Compiler/Library.fs +++ b/src/Fable.Compiler/Library.fs @@ -221,7 +221,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? @@ -265,6 +270,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: CompilerImpl = CompilerImpl( currentFile, @@ -361,6 +369,12 @@ module CodeServices = let opts = cliArgs.CompilerOptions + let warningSuppression = + WarningSuppression.Resolver.FromCompilerOptions( + crackerResponse.ProjectOptions.OtherOptions, + sourceReader + ) + let! results = dependentFiles |> Array.filter (fun filePath -> not (filePath.EndsWith(".fsi", StringComparison.Ordinal))) @@ -375,7 +389,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 0fc37fa99b..8c3703b59f 100644 --- a/src/Fable.Transforms/Babel/Fable2Babel.fs +++ b/src/Fable.Transforms/Babel/Fable2Babel.fs @@ -5065,8 +5065,8 @@ module Compiler = member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) member _.AddSignatureDependency(fileName) = com.AddSignatureDependency(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 73a6506d27..afa3b7c3ef 100644 --- a/src/Fable.Transforms/Beam/Fable2Beam.fs +++ b/src/Fable.Transforms/Beam/Fable2Beam.fs @@ -3844,8 +3844,8 @@ let transformFile (com: Fable.Compiler) (file: File) : Beam.ErlModule = member _.AddWatchDependency(file) = com.AddWatchDependency(file) member _.AddSignatureDependency(file) = com.AddSignatureDependency(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 rec collectMemberDeclarations declarations = diff --git a/src/Fable.Transforms/Dart/Fable2Dart.fs b/src/Fable.Transforms/Dart/Fable2Dart.fs index d590902545..2af55146bd 100644 --- a/src/Fable.Transforms/Dart/Fable2Dart.fs +++ b/src/Fable.Transforms/Dart/Fable2Dart.fs @@ -3210,8 +3210,8 @@ module Compiler = member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) member _.AddSignatureDependency(fileName) = com.AddSignatureDependency(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 4766a44f1a..b2a390d970 100644 --- a/src/Fable.Transforms/Dart/Replacements.fs +++ b/src/Fable.Transforms/Dart/Replacements.fs @@ -1412,7 +1412,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" @@ -2113,8 +2113,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 @@ -2122,10 +2122,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 :: _ -> @@ -2135,10 +2138,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 @@ -2739,8 +2745,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, @@ -2889,11 +2894,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 f14860ef00..d0a500d45f 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -2981,8 +2981,8 @@ type FableCompiler(com: Compiler) = member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) member _.AddSignatureDependency(fileName) = com.AddSignatureDependency(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 738cab2bb8..86cbef389d 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 d1e384ddd6..0820c45006 100644 --- a/src/Fable.Transforms/Global/Compiler.fs +++ b/src/Fable.Transforms/Global/Compiler.fs @@ -90,7 +90,8 @@ type Compiler = abstract AddSignatureDependency: 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 0000000000..885c40dde1 --- /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 0000000000..fa3c32182e --- /dev/null +++ b/src/Fable.Transforms/Global/WarningSuppression.fs @@ -0,0 +1,437 @@ +(* + 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 array + /// 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 array + /// 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) ||> Set.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) ||> Set.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 278f7f8c92..b2921e5964 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) member this.AddSignatureDependency(file) = com.AddSignatureDependency(file) diff --git a/src/Fable.Transforms/Python/PythonCompiler.fs b/src/Fable.Transforms/Python/PythonCompiler.fs index 3b1f062230..dff28d2dc0 100644 --- a/src/Fable.Transforms/Python/PythonCompiler.fs +++ b/src/Fable.Transforms/Python/PythonCompiler.fs @@ -138,8 +138,8 @@ type PythonCompiler(com: Compiler) = member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) member _.AddSignatureDependency(fileName) = com.AddSignatureDependency(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 5ef2df57fe..c1e85e88d7 100644 --- a/src/Fable.Transforms/Python/Replacements.fs +++ b/src/Fable.Transforms/Python/Replacements.fs @@ -1538,7 +1538,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) @@ -1550,7 +1550,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) @@ -2348,8 +2348,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 @@ -2357,10 +2357,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 :: _ -> @@ -2370,10 +2373,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 @@ -2959,8 +2965,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 @@ -3023,24 +3028,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 @@ -3091,7 +3107,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) @@ -3148,7 +3164,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) @@ -3290,8 +3306,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 @@ -3318,7 +3333,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 98df0aef12..5f8f6f2f8d 100644 --- a/src/Fable.Transforms/Replacements.Util.fs +++ b/src/Fable.Transforms/Replacements.Util.fs @@ -1117,6 +1117,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 b934e06f84..9dbbcaff44 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -1860,7 +1860,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) @@ -1870,7 +1870,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) @@ -2755,8 +2755,8 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op && style <> intConst && i.DeclaringEntityFullName <> Types.decimal 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 @@ -2764,10 +2764,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 :: _ -> @@ -2777,10 +2780,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 = if i.DeclaringEntityFullName = Types.decimal then @@ -3331,8 +3337,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 @@ -3375,12 +3380,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) = @@ -3455,7 +3485,7 @@ let dateTime (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op getFieldWith r t thisArg.Value fieldName |> 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) @@ -3566,7 +3596,7 @@ let dateTimeOffset (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: E getFieldWith r t thisArg.Value fieldName |> 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) @@ -3629,7 +3659,7 @@ let dateOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op getFieldWith r t thisArg.Value fieldName |> 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) @@ -3639,7 +3669,7 @@ let timeSpans (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg let moduleName = timeSpanModule com 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, moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -3653,11 +3683,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 @@ -3789,7 +3815,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, moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) @@ -4663,6 +4689,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" @@ -4673,8 +4703,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 4bcf1bbe0c..b27d28f58c 100644 --- a/src/Fable.Transforms/Rust/Fable2Rust.fs +++ b/src/Fable.Transforms/Rust/Fable2Rust.fs @@ -6441,8 +6441,8 @@ module Compiler = member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) member _.AddSignatureDependency(fileName) = com.AddSignatureDependency(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 c242b41b0d..6a44dad331 100644 --- a/src/Fable.Transforms/Rust/Replacements.fs +++ b/src/Fable.Transforms/Rust/Replacements.fs @@ -1464,8 +1464,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 @@ -1647,8 +1646,7 @@ let stringBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Ex libCall com r t "Util" "sb_Append" [ sb; s ] |> 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 @@ -2072,8 +2070,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 @@ -2081,10 +2079,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 :: _ -> @@ -2094,10 +2095,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 @@ -2498,19 +2502,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 c -> makeInstanceCall r t i c memberName args diff --git a/src/Fable.Transforms/State.fs b/src/Fable.Transforms/State.fs index 496ddd55cf..3d6ee95c31 100644 --- a/src/Fable.Transforms/State.fs +++ b/src/Fable.Transforms/State.fs @@ -452,15 +452,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) = @@ -479,7 +481,8 @@ type CompilerImpl ?watchDependencies: HashSet, ?signatureDependencies: HashSet, ?logs: ResizeArray, - ?isPrecompilingInlineFunction: bool + ?isPrecompilingInlineFunction: bool, + ?warningSuppression: WarningSuppression.Resolver ) = @@ -488,6 +491,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 = @@ -535,7 +543,8 @@ type CompilerImpl ?watchDependencies = watchDependencies, ?signatureDependencies = signatureDependencies, logs = logs, - isPrecompilingInlineFunction = true + isPrecompilingInlineFunction = true, + ?warningSuppression = warningSuppression ) member _.GetImplementationFile(fileName) = @@ -599,6 +608,29 @@ type CompilerImpl | Some signatureDependencies when file <> currentFile -> signatureDependencies.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 bbe89065d1..5fa5235db0 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -234,6 +234,9 @@ module Types = [] let rune = "System.Text.Rune" + [] + let cultureInfo = "System.Globalization.CultureInfo" + [] let timer = "System.Timers.Timer" @@ -477,9 +480,6 @@ module Types = [] let iformatProvider = "System.IFormatProvider" - [] - let cultureInfo = "System.Globalization.CultureInfo" - [] let iobserverGeneric = "System.IObserver`1" @@ -680,7 +680,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 @@ -697,11 +704,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 97dac79b02..48622595c6 100644 --- a/src/fable-standalone/src/Fable.Standalone.fsproj +++ b/src/fable-standalone/src/Fable.Standalone.fsproj @@ -25,6 +25,8 @@ + + diff --git a/src/fable-standalone/src/Main.fs b/src/fable-standalone/src/Main.fs index b69ae24298..53a5d0229a 100644 --- a/src/fable-standalone/src/Main.fs +++ b/src/fable-standalone/src/Main.fs @@ -161,6 +161,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) /// `fable precompile` sorts inline expressions by member name, splits them into chunks and records diff --git a/tests/Integration/Compiler/CompilerHelpersTests.fs b/tests/Integration/Compiler/CompilerHelpersTests.fs index 5b4bd5dfa7..a3a2bfa393 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 e686023c12..b55fd2a616 100644 --- a/tests/Integration/Compiler/CompilerMessagesTests.fs +++ b/tests/Integration/Compiler/CompilerMessagesTests.fs @@ -20,6 +20,7 @@ let tests = compile source |> Assert.Is.success |> ignore + testCase "Compile printfn" <| fun _ -> let source = "printfn \"Hello %s\" \"World\"" compile source @@ -31,6 +32,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 @@ -42,6 +44,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 @@ -330,4 +333,20 @@ let isOptions (o: obj) = match o with :? Options -> true | _ -> false compile source |> Assert.Exists.warningWith "Cannot type test (evals to false): Program.Options (pojo)" |> 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 8a2b09954d..3228b28850 100644 --- a/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj +++ b/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj @@ -24,6 +24,8 @@ + + diff --git a/tests/Integration/Compiler/IgnoredArgumentTests.fs b/tests/Integration/Compiler/IgnoredArgumentTests.fs new file mode 100644 index 0000000000..a2af15784f --- /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 d8fddd671f..10e9cea969 100644 --- a/tests/Integration/Compiler/Main.fs +++ b/tests/Integration/Compiler/Main.fs @@ -7,6 +7,8 @@ let allTests = [ CompilerMessages.tests CodeServicesApi.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 45ca9148dc..70e7684c09 100644 --- a/tests/Integration/Compiler/Util/Compiler.fs +++ b/tests/Integration/Compiler/Util/Compiler.fs @@ -32,7 +32,9 @@ module Compiler = let projFile = IO.Path.Join(projDir, name + ".fsproj") |> 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 @@ -56,6 +58,8 @@ module Compiler = let mutable state = State.Create(cliArgs, recompileAllFiles=true) + member _.ProjDir = projDir + member _.Compile(files: (string * string) list) = for (fileName, content) in files do IO.File.WriteAllText(IO.Path.Join(projDir, fileName), content) @@ -74,6 +78,8 @@ module Compiler = let private project = CachedProject("TestProject") let private projectWithSignature = CachedProject("TestProjectSignature") + let projDir = project.ProjDir + let private emptyLibrary = "module Library" + Environment.NewLine let private programFile settings source = @@ -164,6 +170,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) = @@ -228,6 +236,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 0000000000..bda6ca3d3b --- /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 + ] From 8bd886aada5c7659c18c3f8a7d651c8a96857a29 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Wed, 21 Oct 2026 22:25:25 +0200 Subject: [PATCH 2/2] feat(all): port behavior warnings to warning codes --- src/Fable.Transforms/Babel/Fable2Babel.fs | 4 +- src/Fable.Transforms/Dart/Fable2Dart.fs | 4 +- src/Fable.Transforms/Dart/Replacements.fs | 7 +- src/Fable.Transforms/FSharp2Fable.fs | 11 +- src/Fable.Transforms/Global/WarningCodes.fs | 67 ++++++++++ src/Fable.Transforms/Php/Fable2Php.fs | 4 +- .../Python/Fable2Python.Reflection.fs | 2 +- .../Python/Fable2Python.Transforms.fs | 6 +- src/Fable.Transforms/Python/Replacements.fs | 7 +- src/Fable.Transforms/Replacements.fs | 13 +- src/Fable.Transforms/Rust/Fable2Rust.fs | 4 +- src/Fable.Transforms/Rust/Replacements.fs | 15 +-- .../Compiler/BehaviorWarningTests.fs | 117 ++++++++++++++++++ .../Compiler/Fable.Tests.Compiler.fsproj | 1 + tests/Integration/Compiler/Main.fs | 1 + 15 files changed, 223 insertions(+), 40 deletions(-) create mode 100644 tests/Integration/Compiler/BehaviorWarningTests.fs diff --git a/src/Fable.Transforms/Babel/Fable2Babel.fs b/src/Fable.Transforms/Babel/Fable2Babel.fs index 8c3703b59f..45749eb362 100644 --- a/src/Fable.Transforms/Babel/Fable2Babel.fs +++ b/src/Fable.Transforms/Babel/Fable2Babel.fs @@ -476,7 +476,7 @@ module Reflection = let transformTypeTest (com: IBabelCompiler) ctx range expr typ : Expression = let warnAndEvalToFalse msg = - "Cannot type test (evals to false): " + msg |> addWarning com [] range + WarningCodes.typeTestEvalsToFalse msg |> addWarningWithCode com [] range Expression.booleanLiteral (false) @@ -1845,7 +1845,7 @@ module Util = // Some (baseExpr, []) // default base constructor let range = baseCall |> Option.bind (fun x -> x.Range) - $"Ignoring base call for %s{entRef.FullName}" |> addWarning com [] range + WarningCodes.baseCallIgnored entRef.FullName |> addWarningWithCode com [] range None | Some _, _ -> diff --git a/src/Fable.Transforms/Dart/Fable2Dart.fs b/src/Fable.Transforms/Dart/Fable2Dart.fs index 2af55146bd..4b9f9196c1 100644 --- a/src/Fable.Transforms/Dart/Fable2Dart.fs +++ b/src/Fable.Transforms/Dart/Fable2Dart.fs @@ -2038,8 +2038,8 @@ module Util = args | Some(Fable.Value _ as e) -> - $"Ignoring base call for %s{classDecl.Entity.FullName}" - |> addWarning com [] e.Range + WarningCodes.baseCallIgnored classDecl.Entity.FullName + |> addWarningWithCode com [] e.Range [] | Some e -> diff --git a/src/Fable.Transforms/Dart/Replacements.fs b/src/Fable.Transforms/Dart/Replacements.fs index b2a390d970..86ea19665a 100644 --- a/src/Fable.Transforms/Dart/Replacements.fs +++ b/src/Fable.Transforms/Dart/Replacements.fs @@ -2764,7 +2764,7 @@ let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt match i.CompiledName with | "get_Out" -> typedObjExpr t [] |> Some // empty object | "Write" -> - addWarning com ctx.InlinePath r "Write will behave as WriteLine" + WarningCodes.writeBehavesAsWriteLine |> addWarningWithCode com ctx.InlinePath r log com r t i thisArg args |> Some | "WriteLine" -> log com r t i thisArg args |> Some | _ -> None @@ -2772,7 +2772,7 @@ let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with | "Write" -> - addWarning com ctx.InlinePath r "Write will behave as WriteLine" + WarningCodes.writeBehavesAsWriteLine |> addWarningWithCode com ctx.InlinePath r log com r t i thisArg args |> Some | "WriteLine" -> log com r t i thisArg args |> Some | "Break" -> makeDebugger r |> Some @@ -3551,7 +3551,8 @@ let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr lis match i.CompiledName with // TODO: Throw error for RunSynchronously | "Start" -> - "Async.Start will behave as StartImmediate" |> addWarning com ctx.InlinePath r + WarningCodes.asyncStartBehavesAsStartImmediate + |> addWarningWithCode com ctx.InlinePath r Helper.LibCall(com, "Async", "start", t, args, i.SignatureArgTypes, genArgs = i.GenericArgs, ?loc = r) |> Some diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index d0a500d45f..7307c72835 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -43,7 +43,7 @@ let private transformBaseConsCall makeCall r Fable.Unit callInfo baseRef | None -> if not baseCons.IsImplicitConstructor then - "Only inheriting from primary constructors is supported" |> addWarning com [] r + WarningCodes.nonPrimaryBaseConstructor |> addWarningWithCode com [] r match makeCallFrom com ctx r Fable.Unit genArgs None baseArgs baseCons with | Fable.Call(_baseExpr, info, t, r) when not (com.Options.Language = Rust) -> @@ -583,8 +583,8 @@ let private transformUnionCaseTest | TypeScriptTaggedUnion _, _ | _, None -> () | _, Some _ -> - $"CaseTest attribute on '%s{unionCase.Name}' is ignored: it is only supported on TypeScriptTaggedUnion cases" - |> addWarning com ctx.InlinePath r + WarningCodes.caseTestIgnored unionCase.Name + |> addWarningWithCode com ctx.InlinePath r match unionPattern with | ErasedUnionCase -> return "Cannot test erased union cases" |> addErrorAndReturnNull com ctx.InlinePath r @@ -2933,9 +2933,8 @@ type FableCompiler(com: Compiler) = |> List.filter (fun (i, v) -> if ctx.CapturedBindings.Contains(i.Name) && canHaveSideEffects com v then if isIdentUsed i.Name resolved then - $"Inlined argument %s{i.Name} is being captured but is also used somewhere else. " - + "There's a risk of double evaluation." - |> addWarning com [] i.Range + WarningCodes.inlinedArgumentDoubleEvaluation i.Name + |> addWarningWithCode com [] i.Range true else diff --git a/src/Fable.Transforms/Global/WarningCodes.fs b/src/Fable.Transforms/Global/WarningCodes.fs index 885c40dde1..73a25e0d86 100644 --- a/src/Fable.Transforms/Global/WarningCodes.fs +++ b/src/Fable.Transforms/Global/WarningCodes.fs @@ -76,6 +76,60 @@ let privateRepresentationFlagIgnored = let base64ArgumentsIgnored = "FABLE0107", "Base64 offset, length and formatting arguments are ignored" +/// `Console.Write` and `Debug.Write`: the target cannot print without a line break. +let writeBehavesAsWriteLine = "FABLE0108", "Write will behave as WriteLine" + +/// `Async.Start`: there is no thread pool, so the computation starts on the current thread. +let asyncStartBehavesAsStartImmediate = + "FABLE0109", "Async.Start will behave as StartImmediate" + +/// `Task.Result` or `GetAwaiter().GetResult()` on JS/TS, where a task is a promise and nothing can block on it. +let taskResultReturnsTask = + "FABLE0110", + "Task.Result and GetAwaiter().GetResult() return the task itself in JS/TS, as there's no way to block until it completes. Use let! in task { } or Async.AwaitTask instead." + +/// `GetType()` on a value typed `obj`: Fable resolves types at compile time only. +let getTypeOnObj = + "FABLE0111", "Types can only be resolved at compile time. At runtime this will be same as `typeof`" + +/// A `:?` test against a type with no runtime representation (interface, erased type, Pojo class). +let typeTestEvalsToFalse (typeName: string) = + "FABLE0112", $"Cannot type test (evals to false): %s{typeName}" + +/// An `inherit` call whose arguments the target cannot forward to the base constructor. +let baseCallIgnored (entityFullName: string) = + "FABLE0113", $"Ignoring base call for %s{entityFullName}" + +/// An `inherit` through a secondary constructor (`new(...) = ...`). +let nonPrimaryBaseConstructor = + "FABLE0114", "Only inheriting from primary constructors is supported" + +/// An argument of an inlined function that is captured by a closure and also used elsewhere in the body. +let inlinedArgumentDoubleEvaluation (argName: string) = + "FABLE0115", + $"Inlined argument %s{argName} is being captured but is also used somewhere else. There's a risk of double evaluation." + +/// A `CaseTest` attribute on a case of a union that is not a `TypeScriptTaggedUnion`. +let caseTestIgnored (caseName: string) = + "FABLE0116", $"CaseTest attribute on '%s{caseName}' is ignored: it is only supported on TypeScriptTaggedUnion cases" + +/// Rust: `String.Compare` and `String.CompareTo` are compiled as ordinal comparisons. +let stringCompareIsOrdinal (methodName: string) = + "FABLE0117", $"String.%s{methodName} will be compiled as String.CompareOrdinal" + +/// Rust: a `char` is a Unicode scalar value, so it can never be a surrogate. +let charSurrogateTestsAreFalse = + "FABLE0118", "Rust chars are Unicode scalar values, so surrogate tests will be false." + +/// Rust: static and module `do` bindings are skipped unless the `static_do_bindings` feature is enabled. +let staticDoBindingsDisabled = + "FABLE0119", + "For Rust, support for F# static and module do bindings is disabled by default. It can be enabled with the 'static_do_bindings' feature. Use at your own risk!" + +/// PHP: a regex flag with no PCRE modifier, dropped from the pattern. +let regexFlagUnsupported (flag: string) = + "FABLE0120", $"Regex %s{flag} flag is not supported in Php" + /// 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 = @@ -92,6 +146,19 @@ let knownCodes = timeSpanPrecisionIgnored privateRepresentationFlagIgnored base64ArgumentsIgnored + writeBehavesAsWriteLine + asyncStartBehavesAsStartImmediate + taskResultReturnsTask + getTypeOnObj + typeTestEvalsToFalse "" + baseCallIgnored "" + nonPrimaryBaseConstructor + inlinedArgumentDoubleEvaluation "" + caseTestIgnored "" + stringCompareIsOrdinal "" + charSurrogateTestsAreFalse + staticDoBindingsDisabled + regexFlagUnsupported "" ] |> List.map fst |> Set.ofList diff --git a/src/Fable.Transforms/Php/Fable2Php.fs b/src/Fable.Transforms/Php/Fable2Php.fs index b2921e5964..e91811f1e3 100644 --- a/src/Fable.Transforms/Php/Fable2Php.fs +++ b/src/Fable.Transforms/Php/Fable2Php.fs @@ -1509,11 +1509,11 @@ and convertValue (com: IPhpCompiler) (value: Fable.ValueKind) range = | RegexMultiline -> "m" | RegexSingleline -> "s" | RegexGlobal -> - addWarning com [] range "Regex global flag is not supported in Php" + WarningCodes.regexFlagUnsupported "global" |> addWarningWithCode com [] range "" | RegexSticky -> - addWarning com [] range "Regex sticky flag is not supported in Php" + WarningCodes.regexFlagUnsupported "sticky" |> addWarningWithCode com [] range "" ) diff --git a/src/Fable.Transforms/Python/Fable2Python.Reflection.fs b/src/Fable.Transforms/Python/Fable2Python.Reflection.fs index 477d12facf..2148591fa7 100644 --- a/src/Fable.Transforms/Python/Fable2Python.Reflection.fs +++ b/src/Fable.Transforms/Python/Fable2Python.Reflection.fs @@ -340,7 +340,7 @@ let transformReflectionInfo com ctx r (ent: Fable.Entity) generics = let transformTypeTest (com: IPythonCompiler) ctx range expr (typ: Fable.Type) : Expression * Statement list = let warnAndEvalToFalse msg = - "Cannot type test (evals to false): " + msg |> addWarning com [] range + WarningCodes.typeTestEvalsToFalse msg |> addWarningWithCode com [] range Expression.boolConstant false diff --git a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs index 4820be930b..4581313a36 100644 --- a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs +++ b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs @@ -562,7 +562,7 @@ let extractBaseExprFromBaseCall (com: IPythonCompiler) (ctx: Context) (baseType: |> Option.map (fun t -> t.Entity.FullName) |> Option.defaultValue "unknown type" - $"Ignoring base call for %s{name}" |> addWarning com [] range + WarningCodes.baseCallIgnored name |> addWarningWithCode com [] range None | Some(Fable.Value _), Some baseType -> @@ -574,8 +574,8 @@ let extractBaseExprFromBaseCall (com: IPythonCompiler) (ctx: Context) (baseType: // Some (baseExpr, []) // default base constructor let range = baseCall |> Option.bind (fun x -> x.Range) - $"Ignoring base call for %s{baseType.Entity.FullName}" - |> addWarning com [] range + WarningCodes.baseCallIgnored baseType.Entity.FullName + |> addWarningWithCode com [] range None | Some _, _ -> diff --git a/src/Fable.Transforms/Python/Replacements.fs b/src/Fable.Transforms/Python/Replacements.fs index c1e85e88d7..e404a973fb 100644 --- a/src/Fable.Transforms/Python/Replacements.fs +++ b/src/Fable.Transforms/Python/Replacements.fs @@ -1411,8 +1411,7 @@ let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "GetHashCode", Some arg, _ -> identityHash com r arg |> Some | "GetType", Some arg, _ -> if arg.Type = Any then - "Types can only be resolved at compile time. At runtime this will be same as `typeof`" - |> addWarning com ctx.InlinePath r + WarningCodes.getTypeOnObj |> addWarningWithCode com ctx.InlinePath r makeTypeInfo r arg.Type |> Some | _ -> None @@ -2976,7 +2975,7 @@ let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "get_Out" -> Helper.ImportedValue(com, "sys", "stdout", t) |> Some | "get_Error" -> Helper.ImportedValue(com, "sys", "stderr", t) |> Some | "Write" -> - addWarning com ctx.InlinePath r "Write will behave as WriteLine" + WarningCodes.writeBehavesAsWriteLine |> addWarningWithCode com ctx.InlinePath r log com r t i thisArg args |> Some | "ReadLine" -> Helper.GlobalCall("input", t, args, ?loc = r) |> Some | "WriteLine" -> log com r t i thisArg args |> Some @@ -3009,7 +3008,7 @@ let stopwatch (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with | "Write" -> - addWarning com ctx.InlinePath r "Write will behave as WriteLine" + WarningCodes.writeBehavesAsWriteLine |> addWarningWithCode com ctx.InlinePath r log com r t i thisArg args |> Some | "WriteLine" -> log com r t i thisArg args |> Some | "Break" -> makeDebugger r |> Some diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index 9dbbcaff44..c94e9d51b4 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -1733,8 +1733,7 @@ let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "GetHashCode", Some arg, _ -> identityHash com r arg |> Some | "GetType", Some arg, _ -> if arg.Type = Any then - "Types can only be resolved at compile time. At runtime this will be same as `typeof`" - |> addWarning com ctx.InlinePath r + WarningCodes.getTypeOnObj |> addWarningWithCode com ctx.InlinePath r makeTypeInfo (changeRangeToCallSite ctx.InlinePath r) arg.Type |> Some | _ -> None @@ -3348,7 +3347,7 @@ let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "get_Out" -> Helper.GlobalIdent("console", "log", t) |> Some | "get_Error" -> Helper.GlobalIdent("console", "error", t) |> Some | "Write" -> - addWarning com ctx.InlinePath r "Write will behave as WriteLine" + WarningCodes.writeBehavesAsWriteLine |> addWarningWithCode com ctx.InlinePath r log com r t i thisArg args |> Some | "WriteLine" -> log com r t i thisArg args |> Some | _ -> None @@ -3363,7 +3362,7 @@ let textWriter (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with | "Write" -> - addWarning com ctx.InlinePath r "Write will behave as WriteLine" + WarningCodes.writeBehavesAsWriteLine |> addWarningWithCode com ctx.InlinePath r log com r t i thisArg args |> Some | "WriteLine" -> log com r t i thisArg args |> Some | "Break" -> makeDebugger r |> Some @@ -4270,7 +4269,8 @@ let asyncBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = match i.CompiledName with | "Start" -> - "Async.Start will behave as StartImmediate" |> addWarning com ctx.InlinePath r + WarningCodes.asyncStartBehavesAsStartImmediate + |> addWarningWithCode com ctx.InlinePath r Helper.LibCall(com, "Async", "start", t, args, i.SignatureArgTypes, genArgs = i.GenericArgs, ?loc = r) |> Some @@ -4342,8 +4342,7 @@ let tasks (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio match thisArg, i.CompiledName with | Some x, "GetAwaiter" -> Some x | Some x, ("GetResult" | "get_Result" | "Result") -> - "Task.Result and GetAwaiter().GetResult() return the task itself in JS/TS, as there's no way to block until it completes. Use let! in task { } or Async.AwaitTask instead." - |> addWarning com ctx.InlinePath r + WarningCodes.taskResultReturnsTask |> addWarningWithCode com ctx.InlinePath r Some x | None, "Delay" -> diff --git a/src/Fable.Transforms/Rust/Fable2Rust.fs b/src/Fable.Transforms/Rust/Fable2Rust.fs index b27d28f58c..1dbcb27e8a 100644 --- a/src/Fable.Transforms/Rust/Fable2Rust.fs +++ b/src/Fable.Transforms/Rust/Fable2Rust.fs @@ -4896,9 +4896,7 @@ module Util = let transformModuleAction (com: IRustCompiler) ctx (body: Fable.Expr) = // optional, uses startup::on_startup! for static execution (before main). // See also: https://doc.rust-lang.org/1.6.0/complement-design-faq.html#there-is-no-life-before-or-after-main-no-static-ctorsdtors - "For Rust, support for F# static and module do bindings is disabled by default. " - + "It can be enabled with the 'static_do_bindings' feature. Use at your own risk!" - |> addWarning com [] body.Range + WarningCodes.staticDoBindingsDisabled |> addWarningWithCode com [] body.Range let expr = transformExpr com ctx body let attrs = [] //[mkAttr "cfg" ["feature = \"static_do_bindings\""]] diff --git a/src/Fable.Transforms/Rust/Replacements.fs b/src/Fable.Transforms/Rust/Replacements.fs index 6a44dad331..91add9cd16 100644 --- a/src/Fable.Transforms/Rust/Replacements.fs +++ b/src/Fable.Transforms/Rust/Replacements.fs @@ -1338,8 +1338,8 @@ let chars (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | "GetTypeCode", Some c, [] -> makeLibCall com r t i "Char" "GetTypeCode" [ c ] |> Some | ("TryParse" | "Parse") as meth, None, _ -> makeLibCall com r t i "Char" meth args |> Some | ("IsSurrogate" | "IsHighSurrogate" | "IsLowSurrogate" | "IsSurrogatePair") as meth, None, _ -> - $"Rust chars are Unicode scalar values, so surrogate tests will be false." - |> addWarning com ctx.InlinePath r + WarningCodes.charSurrogateTestsAreFalse + |> addWarningWithCode com ctx.InlinePath r let meth = getMethodName meth args @@ -1403,13 +1403,13 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt ExprType(Number(Int32, _)) ] -> libCall com r t "String" "compareOrdinal2" args |> Some | _ -> None | "CompareTo", Some c, [ ExprTypeAs(String, arg) ] -> - $"String.CompareTo will be compiled as String.CompareOrdinal" - |> addWarning com ctx.InlinePath r + WarningCodes.stringCompareIsOrdinal "CompareTo" + |> addWarningWithCode com ctx.InlinePath r libCall com r t "String" "compareOrdinal" [ c; arg ] |> Some | "Compare", None, _ -> - $"String.Compare will be compiled as String.CompareOrdinal" - |> addWarning com ctx.InlinePath r + WarningCodes.stringCompareIsOrdinal "Compare" + |> addWarningWithCode com ctx.InlinePath r match args with | [ ExprType String; ExprType String ] -> libCall com r t "String" "compareOrdinal" args |> Some @@ -3093,7 +3093,8 @@ let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr lis match i.CompiledName with // TODO: Throw error for RunSynchronously | "Start" -> - "Async.Start will behave as StartImmediate" |> addWarning com ctx.InlinePath r + WarningCodes.asyncStartBehavesAsStartImmediate + |> addWarningWithCode com ctx.InlinePath r makeLibCall com r t i "Async" "start" args |> Some // Make sure cancellationToken is called as a function and not a getter diff --git a/tests/Integration/Compiler/BehaviorWarningTests.fs b/tests/Integration/Compiler/BehaviorWarningTests.fs new file mode 100644 index 0000000000..642f6a1234 --- /dev/null +++ b/tests/Integration/Compiler/BehaviorWarningTests.fs @@ -0,0 +1,117 @@ +module Fable.Tests.Compiler.BehaviorWarning + +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 + +(* + Warnings about code that compiles but behaves differently from .NET. Each one carries a + code so that a user who accepts the difference can silence it at the call site. +*) + +let tests = + testList "Behavior Warnings" [ + testCase "Console.Write is reported" <| fun _ -> + let source = + """ +System.Console.Write("x") +""" + compile source + |> Assert.Code.warning "FABLE0108" + |> ignore + + testCase "Console.Write can be suppressed by code" <| fun _ -> + let source = + """ +System.Console.Write("x") // fable-disable-line FABLE0108 +""" + compile source + |> Assert.Code.noWarning "FABLE0108" + |> ignore + + testCase "Async.Start is reported" <| fun _ -> + let source = + """ +Async.Start(async { () }) +""" + compile source + |> Assert.Code.warning "FABLE0109" + |> ignore + + testCase "Task.Result is reported" <| fun _ -> + let source = + """ +let t = task { return 1 } +let r: int = t.Result +""" + compile source + |> Assert.Code.warning "FABLE0110" + |> ignore + + testCase "GetType on obj is reported" <| fun _ -> + let source = + """ +let x: obj = box 1 +x.GetType() |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0111" + |> ignore + + testCase "A type test against an interface is reported" <| fun _ -> + let source = + """ +type IFoo = + abstract X: int + +let isFoo (o: obj) = match o with :? IFoo -> true | _ -> false +""" + compile source + |> Assert.Code.warning "FABLE0112" + |> ignore + + testCase "Inheriting through a secondary constructor is reported" <| fun _ -> + let source = + """ +type Base = + val X: int + new() = { X = 1 } + +type Derived() = + inherit Base() +""" + compile source + |> Assert.Code.warning "FABLE0114" + |> ignore + + testCase "An inlined argument at risk of double evaluation is reported" <| fun _ -> + let source = + """ +let inline orZero (o: int option) = + defaultArg o 0 + (if o.IsSome then 1 else 0) + +orZero (Some(System.Random().Next())) |> ignore +""" + compile source + |> Assert.Code.warning "FABLE0115" + |> ignore + + testCase "CaseTest outside a TypeScriptTaggedUnion is reported" <| fun _ -> + let source = + """ +open Fable.Core + +[] +type Id = + | [] Name of string + | [] Slug of string + +let isName (id: Id) = match id with Name _ -> true | Slug _ -> false +""" + compile source + |> Assert.Code.warning "FABLE0116" + |> ignore + ] diff --git a/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj b/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj index 3228b28850..a7134d6375 100644 --- a/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj +++ b/tests/Integration/Compiler/Fable.Tests.Compiler.fsproj @@ -26,6 +26,7 @@ + diff --git a/tests/Integration/Compiler/Main.fs b/tests/Integration/Compiler/Main.fs index 10e9cea969..7c1909fe97 100644 --- a/tests/Integration/Compiler/Main.fs +++ b/tests/Integration/Compiler/Main.fs @@ -9,6 +9,7 @@ let allTests = CodeServicesApi.tests WarningSuppression.tests IgnoredArgument.tests + BehaviorWarning.tests AnonRecordInInterface.tests CompilerHelpers.tests Inflate.tests