Skip to content

Commit

Permalink
Show obsolete warnings/errors when used with unit of measure (#18182)
Browse files Browse the repository at this point in the history
  • Loading branch information
@edgarfgp
edgarfgp authored Jan 9, 2025
1 parent 23bb605 commit 9ac324d
Show file tree
Hide file tree
Showing 23 changed files with 554 additions and 114 deletions.
1 change: 1 addition & 0 deletions docs/release-notes/.FSharp.Compiler.Service/9.0.200.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
22 changes: 21 additions & 1 deletion src/Compiler/Checking/AttributeChecking.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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) =
Expand Down
2 changes: 2 additions & 0 deletions src/Compiler/Checking/AttributeChecking.fsi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down
13 changes: 10 additions & 3 deletions src/Compiler/Checking/CheckDeclarations.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Checking/CheckPatterns.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
29 changes: 15 additions & 14 deletions src/Compiler/Checking/ConstraintSolver.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
()
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
}

Expand Down Expand Up @@ -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)
}

Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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

| _ ->
Expand All @@ -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

| _ ->
Expand Down Expand Up @@ -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 ->
Expand Down Expand Up @@ -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

| _ ->
Expand Down
Loading

0 comments on commit 9ac324d

Please sign in to comment.