Merge branch 'main' into fix-10697

Author: edgarfgp

docs/release-notes/.FSharp.Compiler.Service/9.0.300.md

@@ -44,7 +44,7 @@
 * Add a switch to determine whether to generate a default implementation body for overridden method when completing. [PR #18341](https://github.com/dotnet/fsharp/pull/18341)
 * Use a more accurate range for CE Combine methods. [PR #18394](https://github.com/dotnet/fsharp/pull/18394)
 * Enable TypeSubsumptionCache for IDE use. [PR #18499](https://github.com/dotnet/fsharp/pull/18499)
-
+* Scoped Nowarn: Add the #warnon compiler directive ([Language suggestion #278](https://github.com/fsharp/fslang-suggestions/issues/278), [RFC FS-1146 PR](https://github.com/fsharp/fslang-design/pull/782), [PR #18049](https://github.com/dotnet/fsharp/pull/18049))
 
 ### Changed
 * FSharpCheckFileResults.ProjectContext.ProjectOptions will not be available when using the experimental Transparent Compiler feature. ([PR #18205](https://github.com/dotnet/fsharp/pull/18205))
@@ -55,6 +55,7 @@
 * Warning for "useless null handling" works with piped syntax constructs now ([PR #18331](https://github.com/dotnet/fsharp/pull/18331))
 * Make indent in generated overridden member code depend on the context, not fix to 4. ([PR #18341](https://github.com/dotnet/fsharp/pull/18341))
 * Adjust caller info attribute error message range ([PR #18388](https://github.com/dotnet/fsharp/pull/18388))
+* Make attribute targets mismatch a warning and not an error ([PR #18492](https://github.com/dotnet/fsharp/pull/18492))
 
 ### Breaking Changes
 * Struct unions with overlapping fields now generate mappings needed for reading via reflection ([Issue #18121](https://github.com/dotnet/fsharp/issues/17797), [PR #18274](https://github.com/dotnet/fsharp/pull/17877))

docs/release-notes/.Language/preview.md

@@ -6,6 +6,7 @@
 * Support ValueOption + Struct attribute as optional parameter for methods ([Language suggestion #1136](https://github.com/fsharp/fslang-suggestions/issues/1136), [PR #18098](https://github.com/dotnet/fsharp/pull/18098))
 * Allow `_` in `use!` bindings values (lift FS1228 restriction) ([PR #18487](https://github.com/dotnet/fsharp/pull/18487))
 * Warn when `unit` is passed to an `obj`-typed argument  ([PR #18330](https://github.com/dotnet/fsharp/pull/18330))
+* Scoped Nowarn: added the #warnon compiler directive ([Language suggestion #278](https://github.com/fsharp/fslang-suggestions/issues/278), [RFC FS-1146 PR](https://github.com/fsharp/fslang-design/pull/782), [PR #18049](https://github.com/dotnet/fsharp/pull/18049))
 
 ### Fixed
 

src/Compiler/Checking/CheckDeclarations.fs

@@ -5752,7 +5752,7 @@ let CheckOneImplFile
         synImplFile,
         diagnosticOptions) =
 
-    let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _, _)) = synImplFile
+    let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, _, implFileFrags, isLastCompiland, _, _)) = synImplFile
     let infoReader = InfoReader(g, amap)
 
     cancellable {
@@ -5891,7 +5891,7 @@ let CheckOneImplFile
            |> Array.map (fun (KeyValue(k,v)) -> (k,v))
            |> Map
 
-        let implFile = CheckedImplFile (qualNameOfFile, scopedPragmas, implFileTy, implFileContents, hasExplicitEntryPoint, isScript, anonRecdTypes, namedDebugPointsForInlinedCode)
+        let implFile = CheckedImplFile (qualNameOfFile, implFileTy, implFileContents, hasExplicitEntryPoint, isScript, anonRecdTypes, namedDebugPointsForInlinedCode)
 
         return (topAttrs, implFile, envAtEnd, cenv.createsGeneratedProvidedTypes)
      } 

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -3187,6 +3187,24 @@ let BuildRecdFieldSet g m objExpr (rfinfo: RecdFieldInfo) argExpr =
     let wrap, objExpr, _readonly, _writeonly = mkExprAddrOfExpr g boxity false DefinitelyMutates objExpr None m
     wrap (mkRecdFieldSetViaExprAddr (objExpr, rfinfo.RecdFieldRef, rfinfo.TypeInst, argExpr, m) )
 
+// This is used to check the target of an attribute with the form of
+// Long Form: [<target:attribute-name(arguments)>]
+// Short Form: [<attribute-name(arguments)>]
+let (|LongFormAttrTarget|UnrecognizedLongAttrTarget|ShortFormAttributeTarget|) (targetIndicator: Ident option) =
+    match targetIndicator with
+    | Some id when id.idText = "assembly" -> LongFormAttrTarget AttributeTargets.Assembly
+    | Some id when id.idText = "module" -> LongFormAttrTarget AttributeTargets.Module
+    | Some id when id.idText = "return" -> LongFormAttrTarget AttributeTargets.ReturnValue
+    | Some id when id.idText = "field" -> LongFormAttrTarget AttributeTargets.Field
+    | Some id when id.idText = "property" -> LongFormAttrTarget AttributeTargets.Property
+    | Some id when id.idText = "method" -> LongFormAttrTarget AttributeTargets.Method
+    | Some id when id.idText = "param" -> LongFormAttrTarget AttributeTargets.Parameter
+    | Some id when id.idText = "type" -> LongFormAttrTarget AttributeTargets.TyconDecl
+    | Some id when id.idText = "constructor" -> LongFormAttrTarget AttributeTargets.Constructor
+    | Some id when id.idText = "event" -> LongFormAttrTarget AttributeTargets.Event
+    | Some id -> UnrecognizedLongAttrTarget id
+    | None -> ShortFormAttributeTarget
+
 //-------------------------------------------------------------------------
 // Helpers dealing with named and optional args at callsites
 //-------------------------------------------------------------------------
@@ -11344,30 +11362,21 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn
                     (validOnDefault, inheritedDefault)
                 | _ ->
                     (validOnDefault, inheritedDefault)
-        let possibleTgts = enum validOn &&& attrTgt
-        let directedTgts =
+        let attributeTargets = enum validOn &&& attrTgt
+        let directedTargets =
             match targetIndicator with
-            | Some id when id.idText = "assembly" -> AttributeTargets.Assembly
-            | Some id when id.idText = "module" -> AttributeTargets.Module
-            | Some id when id.idText = "return" -> AttributeTargets.ReturnValue
-            | Some id when id.idText = "field" -> AttributeTargets.Field
-            | Some id when id.idText = "property" -> AttributeTargets.Property
-            | Some id when id.idText = "method" -> AttributeTargets.Method
-            | Some id when id.idText = "param" -> AttributeTargets.Parameter
-            | Some id when id.idText = "type" -> AttributeTargets.TyconDecl
-            | Some id when id.idText = "constructor" -> AttributeTargets.Constructor
-            | Some id when id.idText = "event" -> AttributeTargets.Event
-            | Some id ->
-                errorR(Error(FSComp.SR.tcUnrecognizedAttributeTarget(), id.idRange))
-                possibleTgts
-            // mask explicit targets
-            | _ -> possibleTgts &&& ~~~ attrEx
-        let constrainedTgts = possibleTgts &&& directedTgts
-        if constrainedTgts = enum 0 then
-            if (directedTgts = AttributeTargets.Assembly || directedTgts = AttributeTargets.Module) then
+            | LongFormAttrTarget attrTarget -> attrTarget
+            | UnrecognizedLongAttrTarget attrTarget ->
+                errorR(Error(FSComp.SR.tcUnrecognizedAttributeTarget(), attrTarget.idRange))
+                attributeTargets
+            | ShortFormAttributeTarget -> attributeTargets &&& ~~~ attrEx
+      
+        let constrainedTargets = attributeTargets &&& directedTargets
+        if constrainedTargets = enum 0 then
+            if (directedTargets = AttributeTargets.Assembly || directedTargets = AttributeTargets.Module) then
                 error(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElementUseDo(), mAttr))
             else
-                error(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElement(), mAttr))
+                warning(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElement(), mAttr))
 
         match ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mAttr ad ty with
         | Exception _ when canFail = TcCanFail.IgnoreAllErrors || canFail = TcCanFail.IgnoreMemberResoutionError -> [ ], true
@@ -11428,19 +11437,19 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn
                     if isStruct then error (Error(FSComp.SR.tcCustomAttributeMustBeReferenceType(), m))
                     if args.Length <> ilMethRef.ArgTypes.Length then error (Error(FSComp.SR.tcCustomAttributeArgumentMismatch(), m))
                     let args = args |> List.map mkAttribExpr
-                    Attrib(tcref, ILAttrib ilMethRef, args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTgts, m)
+                    Attrib(tcref, ILAttrib ilMethRef, args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTargets, m)
 
                 | Expr.App (InnerExprPat(ExprValWithPossibleTypeInst(vref, _, _, _)), _, _, args, _) ->
                     let args = args |> List.collect (function Expr.Const (Const.Unit, _, _) -> [] | expr -> tryDestRefTupleExpr expr) |> List.map mkAttribExpr
-                    Attrib(tcref, FSAttrib vref, args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTgts, mAttr)
+                    Attrib(tcref, FSAttrib vref, args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTargets, mAttr)
 
                 | _ ->
                     error (Error(FSComp.SR.tcCustomAttributeMustInvokeConstructor(), mAttr))
 
             | _ ->
                 error(Error(FSComp.SR.tcAttributeExpressionsMustBeConstructorCalls(), mAttr))
 
-        [ (constrainedTgts, attrib) ], false
+        [ (constrainedTargets, attrib) ], false
 
 and TcAttributesWithPossibleTargetsEx canFail (cenv: cenv) env attrTgt attrEx synAttribs =
 

src/Compiler/CodeGen/IlxGen.fs

@@ -10391,7 +10391,7 @@ and GenModuleBinding cenv (cgbuf: CodeGenBuffer) (qname: QualifiedNameOfFile) la
 
 /// Generate the namespace fragments in a single file
 and GenImplFile cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (implFile: CheckedImplFileAfterOptimization) =
-    let (CheckedImplFile(qname, _, signature, contents, hasExplicitEntryPoint, isScript, anonRecdTypes, _)) =
+    let (CheckedImplFile(qname, signature, contents, hasExplicitEntryPoint, isScript, anonRecdTypes, _)) =
         implFile.ImplFile
 
     let optimizeDuringCodeGen = implFile.OptimizeDuringCodeGen

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -379,7 +379,7 @@ type PhasedDiagnostic with
         // Level 2
         | _ -> 2
 
-    member x.IsEnabled(severity, options) =
+    member private x.IsEnabled(severity, options) =
         let level = options.WarnLevel
         let specificWarnOn = options.WarnOn
         let n = x.Number
@@ -412,19 +412,25 @@ type PhasedDiagnostic with
     member x.AdjustSeverity(options, severity) =
         let n = x.Number
 
-        let warnOff () = List.contains n options.WarnOff
+        let localWarnon () = WarnScopes.IsWarnon options n x.Range
+
+        let localNowarn () = WarnScopes.IsNowarn options n x.Range
+
+        let warnOff () =
+            List.contains n options.WarnOff && not (localWarnon ()) || localNowarn ()
 
         match severity with
         | FSharpDiagnosticSeverity.Error -> FSharpDiagnosticSeverity.Error
         | FSharpDiagnosticSeverity.Warning when
             x.IsEnabled(severity, options)
             && ((options.GlobalWarnAsError && not (warnOff ()))
-                || List.contains n options.WarnAsError)
+                || List.contains n options.WarnAsError && not (localNowarn ()))
             && not (List.contains n options.WarnAsWarn)
             ->
             FSharpDiagnosticSeverity.Error
+        | FSharpDiagnosticSeverity.Info when List.contains n options.WarnAsError && not (localNowarn ()) -> FSharpDiagnosticSeverity.Error
         | FSharpDiagnosticSeverity.Warning when x.IsEnabled(severity, options) && not (warnOff ()) -> FSharpDiagnosticSeverity.Warning
-        | FSharpDiagnosticSeverity.Info when List.contains n options.WarnAsError -> FSharpDiagnosticSeverity.Error
+        | FSharpDiagnosticSeverity.Warning when localWarnon () -> FSharpDiagnosticSeverity.Warning
         | FSharpDiagnosticSeverity.Info when List.contains n options.WarnOn && not (warnOff ()) -> FSharpDiagnosticSeverity.Warning
         | FSharpDiagnosticSeverity.Info when x.IsEnabled(severity, options) && not (warnOff ()) -> FSharpDiagnosticSeverity.Info
         | _ -> FSharpDiagnosticSeverity.Hidden
@@ -2274,51 +2280,25 @@ type PhasedDiagnostic with
             diagnostic.OutputContext(buf, prefix, fileLineFunction)
             diagnostic.Output(buf, tcConfig, severity))
 
-//----------------------------------------------------------------------------
-// Scoped #nowarn pragmas
-
-/// Build an DiagnosticsLogger that delegates to another DiagnosticsLogger but filters warnings turned off by the given pragma declarations
-//
-// NOTE: we allow a flag to turn of strict file checking. This is because file names sometimes don't match due to use of
-// #line directives, e.g. for pars.fs/pars.fsy. In this case we just test by line number - in most cases this is sufficient
-// because we install a filtering error handler on a file-by-file basis for parsing and type-checking.
-// However this is indicative of a more systematic problem where source-line
-// sensitive operations (lexfilter and warning filtering) do not always
-// interact well with #line directives.
-type DiagnosticsLoggerFilteringByScopedPragmas
-    (checkFile, scopedPragmas, diagnosticOptions: FSharpDiagnosticOptions, diagnosticsLogger: DiagnosticsLogger) =
-    inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedPragmas")
+/// Build an DiagnosticsLogger that delegates to another DiagnosticsLogger but filters warnings
+type DiagnosticsLoggerFilteringByScopedNowarn(diagnosticOptions: FSharpDiagnosticOptions, diagnosticsLogger: DiagnosticsLogger) =
+    inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedNowarn")
 
     let mutable realErrorPresent = false
 
     override _.DiagnosticSink(diagnostic: PhasedDiagnostic, severity) =
+
         if severity = FSharpDiagnosticSeverity.Error then
             realErrorPresent <- true
             diagnosticsLogger.DiagnosticSink(diagnostic, severity)
         else
-            let report =
-                let warningNum = diagnostic.Number
-
-                match diagnostic.Range with
-                | Some m ->
-                    scopedPragmas
-                    |> List.exists (fun pragma ->
-                        let (ScopedPragma.WarningOff(pragmaRange, warningNumFromPragma)) = pragma
-
-                        warningNum = warningNumFromPragma
-                        && (not checkFile || m.FileIndex = pragmaRange.FileIndex)
-                        && posGeq m.Start pragmaRange.Start)
-                    |> not
-                | None -> true
-
-            if report then
-                match diagnostic.AdjustSeverity(diagnosticOptions, severity) with
-                | FSharpDiagnosticSeverity.Hidden -> ()
-                | s -> diagnosticsLogger.DiagnosticSink(diagnostic, s)
+            match diagnostic.AdjustSeverity(diagnosticOptions, severity) with
+            | FSharpDiagnosticSeverity.Hidden -> ()
+            | s -> diagnosticsLogger.DiagnosticSink(diagnostic, s)
 
     override _.ErrorCount = diagnosticsLogger.ErrorCount
 
     override _.CheckForRealErrorsIgnoringWarnings = realErrorPresent
 
-let GetDiagnosticsLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOptions, diagnosticsLogger) =
-    DiagnosticsLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, diagnosticsLogger) :> DiagnosticsLogger
+let GetDiagnosticsLoggerFilteringByScopedNowarn (diagnosticOptions, diagnosticsLogger) =
+    DiagnosticsLoggerFilteringByScopedNowarn(diagnosticOptions, diagnosticsLogger) :> DiagnosticsLogger

src/Compiler/Driver/CompilerDiagnostics.fsi

@@ -77,12 +77,8 @@ type PhasedDiagnostic with
             unit
 
 /// Get a diagnostics logger that filters the reporting of warnings based on scoped pragma information
-val GetDiagnosticsLoggerFilteringByScopedPragmas:
-    checkFile: bool *
-    scopedPragmas: ScopedPragma list *
-    diagnosticOptions: FSharpDiagnosticOptions *
-    diagnosticsLogger: DiagnosticsLogger ->
-        DiagnosticsLogger
+val GetDiagnosticsLoggerFilteringByScopedNowarn:
+    diagnosticOptions: FSharpDiagnosticOptions * diagnosticsLogger: DiagnosticsLogger -> DiagnosticsLogger
 
 /// Remove 'implicitIncludeDir' from a file name before output
 val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string