diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 59da87b1bbe..1ef4132a094 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -271,29 +271,6 @@ let GetScopedPragmas (langVersion: LanguageVersion) hashDirectives = |> List.fold processWarnDirectiveInfo (Map.empty, []) |> addOpenPragmas -let GetScopedPragmasForHashDirective hd (langVersion: LanguageVersion) = - let supportsNonStringArguments = - langVersion.SupportsFeature(LanguageFeature.ParsedHashDirectiveArgumentNonQuotes) - - [ - match hd with - | ParsedHashDirective("nowarn", numbers, m) -> - for s in numbers do - let warningNumber = - match supportsNonStringArguments, s with - | _, ParsedHashDirectiveArgument.SourceIdentifier _ -> None - | true, ParsedHashDirectiveArgument.LongIdent _ -> None - | true, ParsedHashDirectiveArgument.Int32(n, _) -> GetWarningNumber(m, string n, true) - | true, ParsedHashDirectiveArgument.Ident(s, _) -> GetWarningNumber(m, s.idText, true) - | _, ParsedHashDirectiveArgument.String(s, _, _) -> GetWarningNumber(m, s, true) - | _ -> None - - match warningNumber with - | None -> () - | Some n -> ScopedPragma.WarningOff(m, n) - | _ -> () - ] - let private collectCodeComments (lexbuf: UnicodeLexing.Lexbuf) (tripleSlashComments: range list) = [ yield! LexbufCommentStore.GetComments(lexbuf) @@ -308,7 +285,7 @@ let PostParseModuleImpls defaultNamespace, fileName, isLastCompiland, - ParsedImplFile(toplevelHashDirectives, impls), + ParsedImplFile(toplevelHashDirectives, impls), // Are toplevelHashDirectives ever non-empty?? lexbuf: UnicodeLexing.Lexbuf, tripleSlashComments: range list, identifiers: Set @@ -373,7 +350,7 @@ let PostParseModuleSpecs defaultNamespace, fileName, isLastCompiland, - ParsedSigFile(hashDirectives, specs), + ParsedSigFile(toplevelHashDirectives, specs), // Can toplevelHashDirectives ever be non-empty?? lexbuf: UnicodeLexing.Lexbuf, tripleSlashComments: range list, identifiers: Set @@ -396,15 +373,18 @@ let PostParseModuleSpecs let qualName = QualFileNameOfSpecs fileName specs let scopedPragmas = - [ - for SynModuleOrNamespaceSig(decls = decls) in specs do - for d in decls do - match d with - | SynModuleSigDecl.HashDirective(hd, _) -> yield! GetScopedPragmasForHashDirective hd lexbuf.LanguageVersion - | _ -> () - for hd in hashDirectives do - yield! GetScopedPragmasForHashDirective hd lexbuf.LanguageVersion - ] + let hashDirectives = + let getModuleSigHashDirectives (SynModuleOrNamespaceSig(decls = decls)) = + let getModuleDeclSigHashDirectives decl = + match decl with + | SynModuleSigDecl.HashDirective(hd, _) -> Some hd + | _ -> None + + decls |> List.choose getModuleDeclSigHashDirectives + + (specs |> List.collect getModuleSigHashDirectives) @ toplevelHashDirectives + + hashDirectives |> GetScopedPragmas lexbuf.LanguageVersion let conditionalDirectives = LexbufIfdefStore.GetTrivia(lexbuf) let codeComments = collectCodeComments lexbuf tripleSlashComments @@ -415,7 +395,7 @@ let PostParseModuleSpecs CodeComments = codeComments } - ParsedInput.SigFile(ParsedSigFileInput(fileName, qualName, scopedPragmas, hashDirectives, specs, trivia, identifiers)) + ParsedInput.SigFile(ParsedSigFileInput(fileName, qualName, scopedPragmas, toplevelHashDirectives, specs, trivia, identifiers)) type ModuleNamesDict = Map> diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerDirectives/Nowarn.fs b/tests/FSharp.Compiler.ComponentTests/CompilerDirectives/Nowarn.fs index a1a9cae1aa0..69b8daf7bb7 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerDirectives/Nowarn.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerDirectives/Nowarn.fs @@ -6,7 +6,6 @@ open FSharp.Test.Compiler module Nowarn = let private warning25Text = "Incomplete pattern matches on this expression. For example, the value 'Some (_)' may indicate a case not covered by the pattern(s)." - let private error3350Text = "Feature '# directives with non-quoted string arguments' is not available in F# 8.0. Please use language version 'PREVIEW' or greater." let private warning44Text = "This construct is deprecated" let private sourceForWarningIsSuppressed = """ @@ -30,29 +29,7 @@ match None with None -> () Warning 25, Line 7, Col 7, Line 7, Col 11, warning25Text ] - let private scriptForWarningIsSuppressed = """ - -match None with None -> () -#nowarn "25" -match None with None -> () -#warnon "25" -match None with None -> () -#nowarn "25" -match None with None -> () - """ - - [] - let ``warning is suppressed between nowarn and warnon directives (in script)`` () = - Fsx scriptForWarningIsSuppressed - |> withLangVersionPreview - |> compile - |> withDiagnostics [ - // These warnings should appear if we make scripts spec-compliant - // Warning 25, Line 3, Col 7, Line 3, Col 11, matchNoneErrorMessage - // Warning 25, Line 7, Col 7, Line 7, Col 11, matchNoneErrorMessage - ] - - let private sourceForWarningIsSuppressedInSigFile = """ + let private sigSourceForWarningIsSuppressedInSigFile = """ module A open System [] @@ -66,12 +43,47 @@ type T4 = T type T5 = T """ + let private sourceForWarningIsSuppressedInSigFile = """ +module A +#nowarn "44" +open System +[] +type T = class end +type T2 = T +type T3 = T +type T4 = T +type T5 = T + """ + [] let ``warning is suppressed between nowarn and warnon directives in a signature file`` () = - Fsi sourceForWarningIsSuppressedInSigFile + Fsi sigSourceForWarningIsSuppressedInSigFile + |> withAdditionalSourceFile (FsSource sourceForWarningIsSuppressedInSigFile) |> withLangVersionPreview |> compile |> withDiagnostics [ Warning 44, Line 6, Col 11, Line 6, Col 12, warning44Text Warning 44, Line 10, Col 11, Line 10, Col 12, warning44Text ] + + let private scriptForWarningIsSuppressed = """ + +match None with None -> () +#nowarn "25" +match None with None -> () +#warnon "25" +match None with None -> () +#nowarn "25" +match None with None -> () + """ + + [] + let ``warning is suppressed between nowarn and warnon directives (in script)`` () = + Fsx scriptForWarningIsSuppressed + |> withLangVersionPreview + |> compile + |> withDiagnostics [ + // These warnings should appear if we make scripts spec-compliant + // Warning 25, Line 3, Col 7, Line 3, Col 11, matchNoneErrorMessage + // Warning 25, Line 7, Col 7, Line 7, Col 11, matchNoneErrorMessage + ]