Update Obsolete attribute checking to account for diagnosticId and urlFormat properties

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

@@ -0,0 +1,8 @@
+### Fixed
+
+### Added
+
+### Changed
+* Update `Obsolete` attribute checking to account for `DiagnosticId` and `UrlFormat` properties. ([PR #18224](https://github.com/dotnet/fsharp/pull/18224))
+
+### Breaking Changes

src/Compiler/Checking/AttributeChecking.fs

@@ -24,8 +24,12 @@ open FSharp.Compiler.TypeProviders
 open FSharp.Core.CompilerServices
 #endif
 
-exception ObsoleteWarning of string * range
-exception ObsoleteError of string * range
+exception ObsoleteDiagnostic of
+    isError: bool *
+    diagnosticId: string *
+    message: string *
+    urlFormat: string *
+    range: range
 
 let fail() = failwith "This custom attribute has an argument that cannot yet be converted using this API"
 
@@ -234,7 +238,6 @@ let MethInfoHasAttribute g m attribSpec minfo  =
                     (fun _ -> Some ())
         |> Option.isSome
 
-
 let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m =
     // In some cases C# will generate both ObsoleteAttribute and CompilerFeatureRequiredAttribute.
     // Specifically, when default constructor is generated for class with any required members in them.
@@ -244,104 +247,138 @@ let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m =
     | Some([ILAttribElem.String (Some featureName) ], _) when featureName = "RequiredMembers" ->
         CompleteD
     | _ ->
-        ErrorD (ObsoleteError(msg, m))
+        ErrorD (ObsoleteDiagnostic(true, "", msg, "", m))
 
 /// Check IL attributes for 'ObsoleteAttribute', returning errors and warnings as data
 let private CheckILAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m =
     let (AttribInfo(tref,_)) = g.attrib_SystemObsolete
     match TryDecodeILAttribute tref cattrs with
     | Some ([ILAttribElem.String (Some msg) ], _) when not isByrefLikeTyconRef ->
-            WarnD(ObsoleteWarning(msg, m))
+            WarnD(ObsoleteDiagnostic(false, "", msg, "", m))
     | Some ([ILAttribElem.String (Some msg); ILAttribElem.Bool isError ], _) when not isByrefLikeTyconRef ->
         if isError then
             if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then
                 CheckCompilerFeatureRequiredAttribute g cattrs msg m
             else
-                ErrorD (ObsoleteError(msg, m))
+                ErrorD (ObsoleteDiagnostic(true, "", msg, "", m))
         else
-            WarnD (ObsoleteWarning(msg, m))
+            WarnD (ObsoleteDiagnostic(false, "", msg, "", m))
+
     | Some ([ILAttribElem.String None ], _) when not isByrefLikeTyconRef ->
-        WarnD(ObsoleteWarning("", m))
+        WarnD(ObsoleteDiagnostic(false, "", "", "", m))
     | Some _ when not isByrefLikeTyconRef ->
-        WarnD(ObsoleteWarning("", m))
+        WarnD(ObsoleteDiagnostic(false, "", "", "", m))
     | _ ->
         CompleteD
 
 let langVersionPrefix = "--langversion:preview"
 
+let private CheckObsoleteAttributes g attribs m =
+    let extractAttribValueFrom name namedArgs   =
+        match namedArgs with 
+        | ExtractAttribNamedArg name (AttribStringArg v) -> v 
+        | _ -> ""
+
+    trackErrors {
+        match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with
+        | Some(Attrib(unnamedArgs= [ AttribStringArg s ]; propVal= namedArgs)) ->
+            let diagnosticId =  extractAttribValueFrom "DiagnosticId" namedArgs
+            let urlFormat = extractAttribValueFrom "UrlFormat" namedArgs
+            do! WarnD(ObsoleteDiagnostic(false, diagnosticId, s, urlFormat, m))
+
+        | Some(Attrib(unnamedArgs= [ AttribStringArg s; AttribBoolArg(isError) ]; propVal= namedArgs)) -> 
+            let diagnosticId = extractAttribValueFrom "DiagnosticId" namedArgs
+            let urlFormat = extractAttribValueFrom "UrlFormat" namedArgs
+            if isError then
+                do! ErrorD (ObsoleteDiagnostic(true, diagnosticId, s, urlFormat, m))
+            else
+                do! WarnD (ObsoleteDiagnostic(false, diagnosticId, s, urlFormat, m))
+        | Some(Attrib(unnamedArgs= [ AttribStringArg s ]; propVal= namedArgs)) ->
+            let diagnosticId = extractAttribValueFrom "DiagnosticId" namedArgs       
+            let urlFormat = extractAttribValueFrom "UrlFormat" namedArgs
+
+            do! WarnD(ObsoleteDiagnostic(false, diagnosticId, s, urlFormat, m))
+        | Some(Attrib(propVal= namedArgs)) ->
+            let diagnosticId = extractAttribValueFrom "DiagnosticId" namedArgs  
+            let urlFormat = extractAttribValueFrom "UrlFormat" namedArgs
+            do! WarnD(ObsoleteDiagnostic(false, diagnosticId, "", urlFormat, m))
+        | None -> 
+            ()
+    }
+
+let private CheckCompilerMessageAttribute g attribs m =
+    trackErrors {
+        match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with
+        | Some(Attrib(unnamedArgs= [ AttribStringArg s ; AttribInt32Arg n ]; propVal= namedArgs)) ->
+            let msg = UserCompilerMessage(s, n, m)
+            let isError = 
+                match namedArgs with 
+                | ExtractAttribNamedArg "IsError" (AttribBoolArg v) -> v 
+                | _ -> false 
+            // If we are using a compiler that supports nameof then error 3501 is always suppressed.
+            // See attribute on FSharp.Core 'nameof'
+            if n = 3501 then
+                ()
+            elif isError && (not g.compilingFSharpCore || n <> 1204) then
+                do! ErrorD msg 
+            else
+                do! WarnD msg
+        | _ -> 
+            ()
+    }
+
+let private CheckExperimentalAttribute g attribs m =
+    trackErrors {
+        match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with
+        | Some(Attrib(unnamedArgs= [ AttribStringArg(s) ])) ->
+            let isExperimentalAttributeDisabled (s:string) =
+                if g.compilingFSharpCore then
+                    true
+                else
+                    g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0)
+            if not (isExperimentalAttributeDisabled s) then
+                do! WarnD(Experimental(s, m))
+        | Some _ ->
+            do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m))
+        | _ ->
+            ()
+    }
+
+let private CheckUnverifiableAttribute g attribs m  =
+    trackErrors {
+        match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with
+        | Some _ -> 
+            do! WarnD(PossibleUnverifiableCode(m))
+        | _ -> ()
+    }
+
 /// Check F# attributes for 'ObsoleteAttribute', 'CompilerMessageAttribute' and 'ExperimentalAttribute',
 /// returning errors and warnings as data
 let CheckFSharpAttributes (g:TcGlobals) attribs m =
     if isNil attribs then CompleteD
     else
         trackErrors {
-            match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with
-            | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) ->
-                do! WarnD(ObsoleteWarning(s, m))
-            | Some(Attrib(_, _, [ AttribStringArg s; AttribBoolArg(isError) ], _, _, _, _)) -> 
-                if isError then 
-                    do! ErrorD (ObsoleteError(s, m))
-                else 
-                    do! WarnD (ObsoleteWarning(s, m))
-            | Some _ -> 
-                do! WarnD(ObsoleteWarning("", m))
-            | None -> 
-                ()
-
-            match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with
-            | Some(Attrib(_, _, [ AttribStringArg s ; AttribInt32Arg n ], namedArgs, _, _, _)) ->
-                let msg = UserCompilerMessage(s, n, m)
-                let isError = 
-                    match namedArgs with 
-                    | ExtractAttribNamedArg "IsError" (AttribBoolArg v) -> v 
-                    | _ -> false 
-                // If we are using a compiler that supports nameof then error 3501 is always suppressed.
-                // See attribute on FSharp.Core 'nameof'
-                if n = 3501 then
-                    ()
-                elif isError && (not g.compilingFSharpCore || n <> 1204) then
-                    do! ErrorD msg 
-                else
-                    do! WarnD msg
-            | _ -> 
-                ()
-
-            match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with
-            | Some(Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) ->
-                let isExperimentalAttributeDisabled (s:string) =
-                    if g.compilingFSharpCore then
-                        true
-                    else
-                        g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0)
-                if not (isExperimentalAttributeDisabled s) then
-                    do! WarnD(Experimental(s, m))
-            | Some _ ->
-                do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m))
-            | _ ->
-                ()
-
-            match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with
-            | Some _ -> 
-                do! WarnD(PossibleUnverifiableCode(m))
-            | _ ->  
-                ()
+            do! CheckObsoleteAttributes g attribs m
+            do! CheckCompilerMessageAttribute g attribs m
+            do! CheckExperimentalAttribute g attribs m
+            do! CheckUnverifiableAttribute g attribs m
         }
 
 #if !NO_TYPEPROVIDERS
 /// Check a list of provided attributes for 'ObsoleteAttribute', returning errors and warnings as data
 let private CheckProvidedAttributes (g: TcGlobals) m (provAttribs: Tainted<IProvidedCustomAttributeProvider>)  = 
     let (AttribInfo(tref, _)) = g.attrib_SystemObsolete
     match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), tref.FullName)), m) with
-    | Some ([ Some (:? string as msg) ], _) -> WarnD(ObsoleteWarning(msg, m))
+    | Some ([ Some (:? string as msg) ], _) -> WarnD(ObsoleteDiagnostic(false, "", msg, "", m))
     | Some ([ Some (:? string as msg); Some (:?bool as isError) ], _) ->
         if isError then 
-            ErrorD (ObsoleteError(msg, m))
+            ErrorD (ObsoleteDiagnostic(true, "", msg, "", m))
         else 
-            WarnD (ObsoleteWarning(msg, m))
+            WarnD (ObsoleteDiagnostic(false, "", msg, "", m))
     | Some ([ None ], _) -> 
-        WarnD(ObsoleteWarning("", m))
+        WarnD(ObsoleteDiagnostic(false, "", "", "", m))
     | Some _ -> 
-        WarnD(ObsoleteWarning("", m))
+        WarnD(ObsoleteDiagnostic(false, "", "", "", m))
     | None -> 
         CompleteD
 #endif

src/Compiler/Checking/AttributeChecking.fsi

@@ -13,9 +13,12 @@ open FSharp.Compiler.TcGlobals
 open FSharp.Compiler.Text
 open FSharp.Compiler.TypedTree
 
-exception ObsoleteWarning of string * range
-
-exception ObsoleteError of string * range
+exception ObsoleteDiagnostic of
+    isError: bool *
+    diagnosticId: string *
+    message: string *
+    urlFormat: string *
+    range: range
 
 type AttribInfo =
     | FSAttribInfo of TcGlobals * Attrib

src/Compiler/Checking/PostInferenceChecks.fs

@@ -551,7 +551,7 @@ let WarnOnWrongTypeForAccess (cenv: cenv) env objName valAcc m ty =
                 if isLessAccessible tyconAcc valAcc then
                     let errorText = FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, (objName())) |> snd
                     let warningText = errorText + Environment.NewLine + FSComp.SR.tcTypeAbbreviationsCheckedAtCompileTime()
-                    warning(AttributeChecking.ObsoleteWarning(warningText, m))
+                    warning(AttributeChecking.ObsoleteDiagnostic(false, "", warningText, "", m))
 
         CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env NoInfo ty
 

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -148,8 +148,7 @@ type Exception with
         | IntfImplInExtrinsicAugmentation m
         | ValueRestriction(_, _, _, _, m)
         | LetRecUnsound(_, _, m)
-        | ObsoleteError(_, m)
-        | ObsoleteWarning(_, m)
+        | ObsoleteDiagnostic(_, _, _, _, m)
         | Experimental(_, m)
         | PossibleUnverifiableCode m
         | UserCompilerMessage(_, _, m)
@@ -266,7 +265,7 @@ type Exception with
         | UnresolvedOverloading _ -> 41
         | LibraryUseOnly _ -> 42
         | ErrorFromAddingConstraint _ -> 43
-        | ObsoleteWarning _ -> 44
+        | ObsoleteDiagnostic(isError = false) -> 44
         | ReservedKeyword _ -> 46
         | SelfRefObjCtor _ -> 47
         | VirtualAugmentationOnNullValuedType _ -> 48
@@ -327,7 +326,7 @@ type Exception with
         | UnresolvedConversionOperator _ -> 93
 
         // avoid 94-100 for safety
-        | ObsoleteError _ -> 101
+        | ObsoleteDiagnostic(isError = true) -> 101
 #if !NO_TYPEPROVIDERS
         | TypeProviders.ProvidedTypeResolutionNoRange _
         | TypeProviders.ProvidedTypeResolution _ -> 103
@@ -1791,9 +1790,7 @@ type Exception with
 
         | ValNotLocal _ -> os.AppendString(ValNotLocalE().Format)
 
-        | ObsoleteError(s, _)
-
-        | ObsoleteWarning(s, _) ->
+        | ObsoleteDiagnostic(message = s) ->
             os.AppendString(Obsolete1E().Format)
 
             if s <> "" then

src/Compiler/Symbols/FSharpDiagnostic.fs

@@ -9,6 +9,7 @@ namespace FSharp.Compiler.Diagnostics
 
 open System
 
+open FSharp.Compiler.AttributeChecking
 open FSharp.Compiler.CheckExpressions
 open FSharp.Compiler.ConstraintSolver
 open FSharp.Compiler.SignatureConformance
@@ -18,7 +19,6 @@ open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TypedTreeOps
 open Internal.Utilities.Library
-open Internal.Utilities.Library.Extras
 
 open FSharp.Core.Printf
 open FSharp.Compiler
@@ -67,6 +67,17 @@ module ExtendedData =
     [<Interface; Experimental("This FCS API is experimental and subject to change.")>]
     type IFSharpDiagnosticExtendedData = interface end
 
+    /// Additional data for diagnostics about obsolete attributes.
+    [<Class; Experimental("This FCS API is experimental and subject to change.")>]
+    type ObsoleteDiagnosticExtendedData
+        internal (diagnosticId: string, urlFormat: string) =
+        interface IFSharpDiagnosticExtendedData
+        /// Represents the DiagnosticId of the diagnostic
+        member this.DiagnosticId: string = diagnosticId
+
+        /// Represents the URL format of the diagnostic
+        member this.UrlFormat: string = urlFormat
+
     [<Experimental("This FCS API is experimental and subject to change.")>]
     type TypeMismatchDiagnosticExtendedData
         internal (symbolEnv: SymbolEnv, dispEnv: DisplayEnv, expectedType: TType, actualType: TType, context: DiagnosticContextInfo) =
@@ -201,6 +212,8 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str
             | DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer(implTycon = implTycon; sigTycon = sigTycon) ->
                 Some(DefinitionsInSigAndImplNotCompatibleAbbreviationsDifferExtendedData(sigTycon, implTycon))
 
+            | ObsoleteDiagnostic(diagnosticId= diagnosticId; urlFormat= urlFormat) ->
+                Some(ObsoleteDiagnosticExtendedData(diagnosticId, urlFormat))
             | _ -> None
 
         let msg =

src/Compiler/Symbols/FSharpDiagnostic.fsi

@@ -50,6 +50,17 @@ module public ExtendedData =
         interface
         end
 
+    /// Additional data for diagnostics about obsolete attributes.
+    [<Class; Experimental("This FCS API is experimental and subject to change.")>]
+    type public ObsoleteDiagnosticExtendedData =
+        interface IFSharpDiagnosticExtendedData
+
+        /// Represents the DiagnosticId of the diagnostic
+        member DiagnosticId: string
+
+        /// Represents the URL format of the diagnostic
+        member UrlFormat: string
+
     /// Additional data for type-mismatch-like (usually with ErrorNumber = 1) diagnostics
     [<Class; Experimental("This FCS API is experimental and subject to change.")>]
     type public TypeMismatchDiagnosticExtendedData =