Show obsolete warnings/errors when used with unit of measure (#18182)

Author: edgarfgp

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

@@ -21,6 +21,7 @@
 * Completion: fix qualified completion in sequence expressions [PR #18111](https://github.com/dotnet/fsharp/pull/18111)
 * Symbols: try to use ValReprInfoForDisplay in Mfv.CurriedParameterGroups ([PR #18124](https://github.com/dotnet/fsharp/pull/18124))
 * Shim/file system: fix leaks of the shim [PR #18144](https://github.com/dotnet/fsharp/pull/18144)
+* Fix for `Obsolete` attribute warning/error not taken into account when used with a unit of measure [PR #18182](https://github.com/dotnet/fsharp/pull/18182)
 
 ### Added
 

src/Compiler/Checking/AttributeChecking.fs

@@ -417,7 +417,27 @@ let CheckEntityAttributes g (tcref: TyconRef) m =
         CheckFSharpAttributes g tcref.Attribs m
 
 let CheckILEventAttributes g (tcref: TyconRef) cattrs m  =    
-    CheckILAttributes g (isByrefLikeTyconRef g m tcref) cattrs m 
+    CheckILAttributes g (isByrefLikeTyconRef g m tcref) cattrs m
+
+let CheckUnitOfMeasureAttributes g (measure: Measure) = 
+    let checkAttribs tm m =
+        let attribs =
+            ListMeasureConOccsWithNonZeroExponents g true tm
+            |> List.map fst
+            |> List.map(_.Attribs)
+            |> List.concat
+
+        CheckFSharpAttributes g attribs m |> CommitOperationResult
+                
+    match measure with
+    | Measure.Const(range = m) -> checkAttribs measure m
+    | Measure.Inv ms -> checkAttribs measure ms.Range
+    | Measure.One(m) -> checkAttribs measure m
+    | Measure.RationalPower(measure = ms1) -> checkAttribs measure ms1.Range
+    | Measure.Prod(measure1= ms1; measure2= ms2) ->
+        checkAttribs ms1 ms1.Range
+        checkAttribs ms2 ms2.Range
+    | Measure.Var(typar) -> checkAttribs measure typar.Range
 
 /// Check the attributes associated with a method, returning warnings and errors as data.
 let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) =

src/Compiler/Checking/AttributeChecking.fsi

@@ -89,6 +89,8 @@ val CheckEntityAttributes: g: TcGlobals -> tcref: TyconRef -> m: range -> Operat
 
 val CheckUnionCaseAttributes: g: TcGlobals -> x: UnionCaseRef -> m: range -> OperationResult<unit>
 
+val CheckUnitOfMeasureAttributes: g: TcGlobals -> measure: Measure -> unit
+
 val CheckRecdFieldAttributes: g: TcGlobals -> x: RecdFieldRef -> m: range -> OperationResult<unit>
 
 val CheckValAttributes: g: TcGlobals -> x: ValRef -> m: range -> OperationResult<unit>

src/Compiler/Checking/CheckDeclarations.fs

@@ -3241,6 +3241,13 @@ module EstablishTypeDefinitionCores =
                                     warning(Error(FSComp.SR.chkAttributeAliased(attrib.TypeRef.FullName), tycon.Id.idRange))
                         | _ -> ()
 
+                    // Check for attributes in unit-of-measure declarations
+                    // [<Measure>] type x = 1<s>
+                    //                        ^
+                    match stripTyEqns g ty with
+                    | TType_measure tm -> CheckUnitOfMeasureAttributes g tm
+                    | _ -> ()
+                        
                     checkAttributeAliased ty tycon g.attrib_AutoOpenAttribute
                     checkAttributeAliased ty tycon g.attrib_StructAttribute
 
@@ -3807,11 +3814,11 @@ module EstablishTypeDefinitionCores =
 
             and accInMeasure measureTy acc =
                 match stripUnitEqns measureTy with
-                | Measure.Const tcref when ListSet.contains (===) tcref.Deref tycons ->  
+                | Measure.Const(tyconRef= tcref) when ListSet.contains (===) tcref.Deref tycons ->  
                     (tycon, tcref.Deref) :: acc
-                | Measure.Const tcref when tcref.IsTypeAbbrev ->              
+                | Measure.Const(tyconRef= tcref) when tcref.IsTypeAbbrev ->              
                     accInMeasure (reduceTyconRefAbbrevMeasureable tcref) acc
-                | Measure.Prod (ms1, ms2) -> accInMeasure ms1 (accInMeasure ms2 acc)
+                | Measure.Prod(measure1= ms1; measure2= ms2) -> accInMeasure ms1 (accInMeasure ms2 acc)
                 | Measure.Inv invTy -> accInMeasure invTy acc
                 | _ -> acc
 

src/Compiler/Checking/CheckPatterns.fs

@@ -803,7 +803,7 @@ and TcPatLongIdentLiteral warnOnUpper (cenv: cenv) env vFlags patEnv ty (mLongId
     match vref.LiteralValue with
     | None -> error (Error(FSComp.SR.tcNonLiteralCannotBeUsedInPattern(), m))
     | Some lit ->
-        let _, _, _, vexpty, _, _ = TcVal true cenv env tpenv vref None None mLongId
+        let _, _, _, vexpty, _, _ = TcVal cenv env tpenv vref None None mLongId
         CheckValAccessible mLongId env.AccessRights vref
         CheckFSharpAttributes g vref.Attribs mLongId |> CommitOperationResult
         CheckNoArgsForLiteral args m

src/Compiler/Checking/ConstraintSolver.fs

@@ -42,6 +42,7 @@
 
 module internal FSharp.Compiler.ConstraintSolver
 
+open FSharp.Compiler.Text.Range
 open Internal.Utilities.Collections
 open Internal.Utilities.Library
 open Internal.Utilities.Library.Extras
@@ -734,7 +735,7 @@ let SubstMeasureWarnIfRigid (csenv: ConstraintSolverEnv) trace (v: Typar) ms =
             // Propagate static requirements from 'tp' to 'ty'
             do! SolveTypStaticReq csenv trace v.StaticReq (TType_measure ms)
             SubstMeasure v ms
-            if v.Rigidity = TyparRigidity.Anon && measureEquiv csenv.g ms Measure.One then 
+            if v.Rigidity = TyparRigidity.Anon && measureEquiv csenv.g ms (Measure.One ms.Range) then 
                 return! WarnD(Error(FSComp.SR.csCodeLessGeneric(), v.Range))
             else
                 ()
@@ -760,17 +761,17 @@ let UnifyMeasureWithOne (csenv: ConstraintSolverEnv) trace ms =
     match FindPreferredTypar nonRigidVars with
     | (v, e) :: vs ->
         let unexpandedCons = ListMeasureConOccsWithNonZeroExponents csenv.g false ms
-        let newms = ProdMeasures (List.map (fun (c, e') -> Measure.RationalPower (Measure.Const c, NegRational (DivRational e' e))) unexpandedCons 
+        let newms = ProdMeasures (List.map (fun (c, e') -> Measure.RationalPower(Measure.Const(c, ms.Range), NegRational (DivRational e' e))) unexpandedCons 
                                 @ List.map (fun (v, e') -> Measure.RationalPower (Measure.Var v, NegRational (DivRational e' e))) (vs @ rigidVars))
 
         SubstMeasureWarnIfRigid csenv trace v newms
 
     // Otherwise we require ms to be 1
-    | [] -> if measureEquiv csenv.g ms Measure.One then CompleteD else localAbortD
+    | [] -> if measureEquiv csenv.g ms (Measure.One ms.Range) then CompleteD else localAbortD
 
 /// Imperatively unify unit-of-measure expression ms1 against ms2
 let UnifyMeasures (csenv: ConstraintSolverEnv) trace ms1 ms2 = 
-    UnifyMeasureWithOne csenv trace (Measure.Prod(ms1, Measure.Inv ms2))
+    UnifyMeasureWithOne csenv trace (Measure.Prod(ms1, Measure.Inv ms2, (unionRanges ms1.Range ms2.Range)))
 
 /// Simplify a unit-of-measure expression ms that forms part of a type scheme. 
 /// We make substitutions for vars, which are the (remaining) bound variables
@@ -791,7 +792,7 @@ let SimplifyMeasure g vars ms =
           let newms =
               ProdMeasures [
                   for (c, e') in nonZeroCon do
-                      Measure.RationalPower (Measure.Const c, NegRational (DivRational e' e)) 
+                      Measure.RationalPower (Measure.Const(c, ms.Range), NegRational (DivRational e' e)) 
                   for (v', e') in nonZeroVar do
                       if typarEq v v' then 
                           newvarExpr 
@@ -1329,13 +1330,13 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr
         // Catch float<_>=float<1>, float32<_>=float32<1> and decimal<_>=decimal<1> 
         | (_, TType_app (tc2, [ms2], _)) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2])) ->
             trackErrors {
-                do! SolveTypeEqualsType csenv ndeep m2 trace None (TType_measure Measure.One) ms2
+                do! SolveTypeEqualsType csenv ndeep m2 trace None (TType_measure(Measure.One m2)) ms2
                 do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2)
             }
 
         | (TType_app (tc1, [ms1], _), _) when (tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1])) ->
             trackErrors {
-                do! SolveTypeEqualsType csenv ndeep m2 trace None ms1 (TType_measure Measure.One)
+                do! SolveTypeEqualsType csenv ndeep m2 trace None ms1 (TType_measure(Measure.One m2))
                 do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2)
             }
 
@@ -1518,13 +1519,13 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional
         // Enforce the identities float=float<1>, float32=float32<1> and decimal=decimal<1> 
         | _, TType_app (tc2, [ms2], _) when tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2]) ->
             trackErrors {
-                do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms2 (TType_measure Measure.One)
+                do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms2 (TType_measure(Measure.One m2))
                 do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2)
             }
 
         | TType_app (tc1, [ms1], _), _ when tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1]) ->
             trackErrors {
-                do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms1 (TType_measure Measure.One)
+                do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms1 (TType_measure(Measure.One m2))
                 do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2)
             }
 
@@ -1620,7 +1621,7 @@ and DepthCheck ndeep m =
 and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
     match getMeasureOfType csenv.g ty with
     | Some (tcref, _) -> 
-        SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty (mkWoNullAppTy tcref [TType_measure Measure.One])
+        SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty (mkWoNullAppTy tcref [TType_measure(Measure.One m2)])
     | None ->
         CompleteD
 
@@ -1727,7 +1728,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                         | Some (tcref, ms1) ->
                             let ms2 = freshMeasure ()
                             do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 (mkWoNullAppTy tcref [TType_measure ms2])
-                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))])
+                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, (if nm = "op_Multiply" then ms2 else Measure.Inv ms2), unionRanges ms1.Range ms2.Range))])
                             return TTraitBuiltIn
 
                         | _ ->
@@ -1736,7 +1737,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                             | Some (tcref, ms2) ->
                                 let ms1 = freshMeasure ()
                                 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure ms1]) 
-                                do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))])
+                                do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, (if nm = "op_Multiply" then ms2 else Measure.Inv ms2), unionRanges ms1.Range ms2.Range))])
                                 return TTraitBuiltIn
 
                             | _ ->
@@ -1870,7 +1871,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                         match getMeasureOfType g argTy1 with
                             | Some (tcref, _) -> 
                                 let ms1 = freshMeasure () 
-                                do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))])
+                                do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure (Measure.Prod (ms1, ms1, ms1.Range))])
                                 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure ms1])
                                 return TTraitBuiltIn
                             | None -> 
@@ -1923,7 +1924,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                         do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1
                         match getMeasureOfType g argTy1 with
                         | None -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1
-                        | Some (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure Measure.One])
+                        | Some (tcref, ms) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure(Measure.One ms.Range)])
                         return TTraitBuiltIn
 
                     | _ ->