Merge pull request #18251 from dotnet/merges/main-to-release/dev17.14

Merge main to release/dev17.14

Author: 0101

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

@@ -1,14 +1,12 @@
 ### Fixed
-
 * Fix Realsig+ generates nested closures with incorrect Generic  ([Issue #17797](https://github.com/dotnet/fsharp/issues/17797), [PR #17877](https://github.com/dotnet/fsharp/pull/17877))
+* Fix internal error when missing measure attribute in an unsolved measure typar. ([Issue #7491](https://github.com/dotnet/fsharp/issues/7491), [PR #18234](https://github.com/dotnet/fsharp/pull/18234)==
 * Set `Cancellable.token` from async computation ([Issue #18235](https://github.com/dotnet/fsharp/issues/18235), [PR #18238](https://github.com/dotnet/fsharp/pull/18238))
 
 ### Added
-
 * Added missing type constraints in FCS. ([PR #18241](https://github.com/dotnet/fsharp/pull/18241))
 
 ### 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,177 @@ 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))
+
+let private extractILObsoleteAttributeInfo namedArgs =
+    let extractILAttribValueFrom name namedArgs   =
+        match namedArgs with 
+        | ExtractILAttributeNamedArg name (AttribElemStringArg v) -> v 
+        | _ -> ""
+    let diagnosticId = extractILAttribValueFrom "DiagnosticId" namedArgs
+    let urlFormat = extractILAttribValueFrom "UrlFormat" namedArgs
+    (diagnosticId, urlFormat)
+
+let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m =
+    if isByrefLikeTyconRef then
+        CompleteD
+    else
+        let (AttribInfo(tref,_)) = g.attrib_SystemObsolete
+        match TryDecodeILAttribute tref cattrs with
+        // [<Obsolete>]
+        // [<Obsolete("Message")>]
+        // [<Obsolete("Message", true)>]
+        // [<Obsolete("Message", DiagnosticId = "DiagnosticId")>]
+        // [<Obsolete("Message", DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
+        // [<Obsolete(DiagnosticId = "DiagnosticId")>]
+        // [<Obsolete(DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
+        // [<Obsolete("Message", true, DiagnosticId = "DiagnosticId")>]
+        // [<Obsolete("Message", true, DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
+        // Constructors deciding on IsError and Message properties.
+        | Some ([ attribElement ], namedArgs) ->
+            let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs
+            let msg = 
+                match attribElement with 
+                | ILAttribElem.String (Some msg) -> msg
+                | ILAttribElem.String None
+                | _ -> ""
+
+            WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m))
+        | Some ([ILAttribElem.String (Some msg); ILAttribElem.Bool isError ], namedArgs) ->
+            let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs
+            if isError then
+                if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then
+                    CheckCompilerFeatureRequiredAttribute g cattrs msg m
+                else
+                    ErrorD (ObsoleteDiagnostic(true, diagnosticId, msg, urlFormat, m))
+            else
+                WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m))
+        // Only DiagnosticId, UrlFormat
+        | Some (_, namedArgs) ->
+            let diagnosticId, urlFormat = extractILObsoleteAttributeInfo namedArgs
+            WarnD(ObsoleteDiagnostic(false, diagnosticId, "", urlFormat, m))
+        // No arguments
+        | None -> CompleteD
 
 /// 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))
-    | 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))
-        else
-            WarnD (ObsoleteWarning(msg, m))
-    | Some ([ILAttribElem.String None ], _) when not isByrefLikeTyconRef ->
-        WarnD(ObsoleteWarning("", m))
-    | Some _ when not isByrefLikeTyconRef ->
-        WarnD(ObsoleteWarning("", m))
-    | _ ->
-        CompleteD
+    trackErrors {
+        do! CheckILObsoleteAttributes g isByrefLikeTyconRef cattrs m
+    }
 
 let langVersionPrefix = "--langversion:preview"
 
+let private extractObsoleteAttributeInfo namedArgs =
+    let extractILAttribValueFrom name namedArgs   =
+        match namedArgs with 
+        | ExtractAttribNamedArg name (AttribStringArg v) -> v 
+        | _ -> ""
+    let diagnosticId = extractILAttribValueFrom "DiagnosticId" namedArgs
+    let urlFormat = extractILAttribValueFrom "UrlFormat" namedArgs
+    (diagnosticId, urlFormat)
+
+let private CheckObsoleteAttributes g attribs m =
+    trackErrors {
+        match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with
+        // [<Obsolete>]
+        // [<Obsolete("Message")>]
+        // [<Obsolete("Message", true)>]
+        // [<Obsolete("Message", DiagnosticId = "DiagnosticId")>]
+        // [<Obsolete("Message", DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
+        // [<Obsolete(DiagnosticId = "DiagnosticId")>]
+        // [<Obsolete(DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
+        // [<Obsolete("Message", true, DiagnosticId = "DiagnosticId")>]
+        // [<Obsolete("Message", true, DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")>]
+        // Constructors deciding on IsError and Message properties.
+        | Some(Attrib(unnamedArgs= [ AttribStringArg s ]; propVal= namedArgs)) ->
+            let diagnosticId, urlFormat = extractObsoleteAttributeInfo namedArgs
+            do! WarnD(ObsoleteDiagnostic(false, diagnosticId, s, urlFormat, m))
+        | Some(Attrib(unnamedArgs= [ AttribStringArg s; AttribBoolArg(isError) ]; propVal= namedArgs)) -> 
+            let diagnosticId, urlFormat = extractObsoleteAttributeInfo namedArgs
+            if isError then
+                do! ErrorD (ObsoleteDiagnostic(true, diagnosticId, s, urlFormat, m))
+            else
+                do! WarnD (ObsoleteDiagnostic(false, diagnosticId, s, urlFormat, m))
+        // Only DiagnosticId, UrlFormat
+        | Some(Attrib(propVal= namedArgs)) ->
+            let diagnosticId, urlFormat = extractObsoleteAttributeInfo 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
@@ -1790,9 +1789,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/FSComp.txt

@@ -1789,5 +1789,6 @@ featureUseTypeSubsumptionCache,"Use type conversion cache during compilation"
 3872,tcPartialActivePattern,"Multi-case partial active patterns are not supported. Consider using a single-case partial active pattern or a full active pattern."
 featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase identifiers in binding patterns"
 3873,chkDeprecatePlacesWhereSeqCanBeOmitted,"This construct is deprecated. Sequence expressions should be of the form 'seq {{ ... }}'"
+3874,tcExpectedTypeParamMarkedWithUnitOfMeasureAttribute,"Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute."
 featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted"
 featureSupportValueOptionsAsOptionalParameters,"Support ValueOption as valid type for optional member parameters"