Skip to content

Bugfix: Pattern match incompleteness for enum was hiding more serious issues #15618

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Jul 19, 2023
Merged

Bugfix: Pattern match incompleteness for enum was hiding more serious issues #15618

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
4534a60
let's see what breaks
T-Gro Jul 18, 2023
aba4e76
Max 1 generated throw handler. Warnings for enums/other scenarios rep…
T-Gro Jul 19, 2023
c634954
PR feedback
T-Gro Jul 19, 2023
5fb438d
Merge remote-tracking branch 'upstream/main' into 15597-incomplete-ma…
T-Gro Jul 19, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
203 changes: 109 additions & 94 deletions src/Compiler/Checking/PatternMatchCompilation.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -194,7 +194,17 @@ let ilFieldToTastConst lit =
| ILFieldInit.Double f -> Const.Double f

exception CannotRefute
let RefuteDiscrimSet g m path discrims =

[<Struct>]
[<RequireQualifiedAccess>]
type CounterExampleType =
/// Maps to EnumMatchIncomplete exn
| EnumCoversKnown
/// Maps to MatchIncomplete exn
| WithoutEnum
with member x.Combine(other) = match other with EnumCoversKnown -> other | _ -> x

let RefuteDiscrimSet g m path discrims : Expr * CounterExampleType =
let mkUnknown ty = snd(mkCompGenLocal m "_" ty)
let rec go path tm =
match path with
Expand All @@ -221,16 +231,16 @@ let RefuteDiscrimSet g m path discrims =
| PathEmpty ty -> tm ty

and mkOneKnown tm n tys =
let flds = List.mapi (fun i ty -> if i = n then tm ty else (mkUnknown ty, false)) tys
List.map fst flds, List.fold (fun acc (_, eCoversVals) -> eCoversVals || acc) false flds
let flds = List.mapi (fun i ty -> if i = n then tm ty else (mkUnknown ty, CounterExampleType.WithoutEnum)) tys
List.map fst flds, List.fold (fun acc (_, eCoversVals) -> acc.Combine(eCoversVals)) CounterExampleType.WithoutEnum flds
and mkUnknowns tys = List.map (fun x -> mkUnknown x) tys

let tm ty =
match discrims with
| [DecisionTreeTest.IsNull] ->
snd(mkCompGenLocal m notNullText ty), false
snd(mkCompGenLocal m notNullText ty), CounterExampleType.WithoutEnum
| DecisionTreeTest.IsInst _ :: _ ->
snd(mkCompGenLocal m otherSubtypeText ty), false
snd(mkCompGenLocal m otherSubtypeText ty), CounterExampleType.WithoutEnum
| DecisionTreeTest.Const c :: rest ->
let consts = Set.ofList (c :: List.choose (function DecisionTreeTest.Const c -> Some c | _ -> None) rest)
let c' =
Expand Down Expand Up @@ -279,11 +289,11 @@ let RefuteDiscrimSet g m path discrims =
let nonCoveredEnumValues = Seq.tryFind (fun (_, fldValue) -> not (consts.Contains fldValue)) enumValues

match nonCoveredEnumValues with
| None -> Expr.Const (c, m, ty), true
| None -> Expr.Const (c, m, ty), CounterExampleType.EnumCoversKnown
| Some (fldName, _) ->
let v = RecdFieldRef.RecdFieldRef(tcref, fldName)
Expr.Op (TOp.ValFieldGet v, [ty], [], m), false
| _ -> Expr.Const (c, m, ty), false
Expr.Op (TOp.ValFieldGet v, [ty], [], m), CounterExampleType.WithoutEnum
| _ -> Expr.Const (c, m, ty), CounterExampleType.WithoutEnum

| DecisionTreeTest.UnionCase (ucref1, tinst) :: rest ->
let ucrefs = ucref1 :: List.choose (function DecisionTreeTest.UnionCase(ucref, _) -> Some ucref | _ -> None) rest
Expand All @@ -297,10 +307,10 @@ let RefuteDiscrimSet g m path discrims =
| [] -> raise CannotRefute
| ucref2 :: _ ->
let flds = ucref2 |> actualTysOfUnionCaseFields (mkTyconRefInst tcref tinst) |> mkUnknowns
Expr.Op (TOp.UnionCase ucref2, tinst, flds, m), false
Expr.Op (TOp.UnionCase ucref2, tinst, flds, m), CounterExampleType.WithoutEnum

| [DecisionTreeTest.ArrayLength (n, ty)] ->
Expr.Op (TOp.Array, [ty], mkUnknowns (List.replicate (n+1) ty), m), false
Expr.Op (TOp.Array, [ty], mkUnknowns (List.replicate (n+1) ty), m), CounterExampleType.WithoutEnum

| _ ->
raise CannotRefute
Expand Down Expand Up @@ -356,7 +366,7 @@ let ShowCounterExample g denv m refuted =
| [] -> raise CannotRefute
| (r, eck) :: t ->
((r, eck), t) ||> List.fold (fun (rAcc, eckAcc) (r, eck) ->
CombineRefutations g rAcc r, eckAcc || eck)
CombineRefutations g rAcc r, eckAcc.Combine(eck))
let text = LayoutRender.showL (NicePrint.dataExprL denv counterExample)
let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false)
Some(text, failingWhenClause, enumCoversKnown)
Expand Down Expand Up @@ -995,102 +1005,107 @@ let CompilePatternBasic

// Add the incomplete or rethrow match clause on demand,
// printing a warning if necessary (only if it is ever exercised).
let mutable incompleteMatchClauseOnce = None
let mutable firstIncompleteMatchClauseWithThrowExpr = None
let warningsGenerated = new ResizeArray<CounterExampleType>(2)
let getIncompleteMatchClause refuted =
// This is lazy because emit a warning when the lazy thunk gets evaluated.
match incompleteMatchClauseOnce with
| None ->
// Emit the incomplete match warning.
if warnOnIncomplete then
match actionOnFailure with
| ThrowIncompleteMatchException | IgnoreWithWarning ->
let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning)
match ShowCounterExample g denv mMatch refuted with
| Some(text, failingWhenClause, true) ->
warning (EnumMatchIncomplete(ignoreWithWarning, Some(text, failingWhenClause), mMatch))
| Some(text, failingWhenClause, false) ->
warning (MatchIncomplete(ignoreWithWarning, Some(text, failingWhenClause), mMatch))
| None ->
warning (MatchIncomplete(ignoreWithWarning, None, mMatch))
| _ ->
()

let throwExpr =
match actionOnFailure with
| FailFilter ->
// Return 0 from the .NET exception filter.
mkInt g mMatch 0

| Rethrow ->
// Rethrow unmatched try-with exn. No sequence point at the target since its not real code.
mkReraise mMatch resultTy

| Throw ->
let findMethInfo ty isInstance name (sigTys: TType list) =
TryFindIntrinsicMethInfo infoReader mMatch AccessorDomain.AccessibleFromEverywhere name ty
|> List.tryFind (fun methInfo ->
methInfo.IsInstance = isInstance &&
(
match methInfo.GetParamTypes(amap, mMatch, []) with
| [] -> false
| argTysList ->
let argTys = (argTysList |> List.reduce (@)) @ [ methInfo.GetFSharpReturnType (amap, mMatch, []) ]
if argTys.Length <> sigTys.Length then
false
else
(argTys, sigTys)
||> List.forall2 (typeEquiv g)
)
// Emit the incomplete match warning.
if warnOnIncomplete then
match actionOnFailure with
| ThrowIncompleteMatchException
| IgnoreWithWarning ->
let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning)
let counterExample = ShowCounterExample g denv mMatch refuted
match counterExample with
| Some(text, failingWhenClause, CounterExampleType.EnumCoversKnown) when not(warningsGenerated.Contains(CounterExampleType.EnumCoversKnown)) ->
warning (EnumMatchIncomplete(ignoreWithWarning, Some(text, failingWhenClause), mMatch))
warningsGenerated.Add CounterExampleType.EnumCoversKnown
| Some(text, failingWhenClause, CounterExampleType.WithoutEnum) when not(warningsGenerated.Contains(CounterExampleType.WithoutEnum)) ->
warning (MatchIncomplete(ignoreWithWarning, Some(text, failingWhenClause), mMatch))
warningsGenerated.Add CounterExampleType.WithoutEnum
| None when not(warningsGenerated.Contains(CounterExampleType.WithoutEnum)) ->
warning (MatchIncomplete(ignoreWithWarning, None, mMatch))
warningsGenerated.Add CounterExampleType.WithoutEnum
| _ -> ()
| _ ->
()

let throwExpr() =
match actionOnFailure with
| FailFilter ->
// Return 0 from the .NET exception filter.
mkInt g mMatch 0

| Rethrow ->
// Rethrow unmatched try-with exn. No sequence point at the target since its not real code.
mkReraise mMatch resultTy

| Throw ->
let findMethInfo ty isInstance name (sigTys: TType list) =
TryFindIntrinsicMethInfo infoReader mMatch AccessorDomain.AccessibleFromEverywhere name ty
|> List.tryFind (fun methInfo ->
methInfo.IsInstance = isInstance &&
(
match methInfo.GetParamTypes(amap, mMatch, []) with
| [] -> false
| argTysList ->
let argTys = (argTysList |> List.reduce (@)) @ [ methInfo.GetFSharpReturnType (amap, mMatch, []) ]
if argTys.Length <> sigTys.Length then
false
else
(argTys, sigTys)
||> List.forall2 (typeEquiv g)
)
)

// We use throw, or EDI.Capture(exn).Throw() when EDI is supported, instead of rethrow on unmatched try-with in a computation expression.
// But why? Because this isn't a real .NET exception filter/handler but just a function we're passing
// to a computation expression builder to simulate one.
let ediCaptureMethInfo, ediThrowMethInfo =
// EDI.Capture: exn -> EDI
g.system_ExceptionDispatchInfo_ty
|> Option.bind (fun ty -> findMethInfo ty false "Capture" [ g.exn_ty; ty ]),
// edi.Throw: unit -> unit
g.system_ExceptionDispatchInfo_ty
|> Option.bind (fun ty -> findMethInfo ty true "Throw" [ g.unit_ty ])

match Option.map2 (fun x y -> x,y) ediCaptureMethInfo ediThrowMethInfo with
| None ->
mkThrow mMatch resultTy (exprForVal mMatch origInputVal)
| Some (ediCaptureMethInfo, ediThrowMethInfo) ->
let edi, _ =
BuildMethodCall tcVal g amap NeverMutates mMatch false
ediCaptureMethInfo ValUseFlag.NormalValUse [] [] [ (exprForVal mMatch origInputVal) ] None

let e, _ =
BuildMethodCall tcVal g amap NeverMutates mMatch false
ediThrowMethInfo ValUseFlag.NormalValUse [] [edi] [ ] None

// We use throw, or EDI.Capture(exn).Throw() when EDI is supported, instead of rethrow on unmatched try-with in a computation expression.
// But why? Because this isn't a real .NET exception filter/handler but just a function we're passing
// to a computation expression builder to simulate one.
let ediCaptureMethInfo, ediThrowMethInfo =
// EDI.Capture: exn -> EDI
g.system_ExceptionDispatchInfo_ty
|> Option.bind (fun ty -> findMethInfo ty false "Capture" [ g.exn_ty; ty ]),
// edi.Throw: unit -> unit
g.system_ExceptionDispatchInfo_ty
|> Option.bind (fun ty -> findMethInfo ty true "Throw" [ g.unit_ty ])

match Option.map2 (fun x y -> x,y) ediCaptureMethInfo ediThrowMethInfo with
| None ->
mkThrow mMatch resultTy (exprForVal mMatch origInputVal)
| Some (ediCaptureMethInfo, ediThrowMethInfo) ->
let edi, _ =
BuildMethodCall tcVal g amap NeverMutates mMatch false
ediCaptureMethInfo ValUseFlag.NormalValUse [] [] [ (exprForVal mMatch origInputVal) ] None

let e, _ =
BuildMethodCall tcVal g amap NeverMutates mMatch false
ediThrowMethInfo ValUseFlag.NormalValUse [] [edi] [ ] None

mkCompGenSequential mMatch e (mkDefault (mMatch, resultTy))

| ThrowIncompleteMatchException ->
mkThrow mMatch resultTy
(mkExnExpr(g.MatchFailureException_tcr,
[ mkString g mMatch mMatch.FileName
mkInt g mMatch mMatch.StartLine
mkInt g mMatch mMatch.StartColumn], mMatch))

| IgnoreWithWarning ->
mkUnit g mMatch
mkCompGenSequential mMatch e (mkDefault (mMatch, resultTy))

| ThrowIncompleteMatchException ->
mkThrow mMatch resultTy
(mkExnExpr(g.MatchFailureException_tcr,
[ mkString g mMatch mMatch.FileName
mkInt g mMatch mMatch.StartLine
mkInt g mMatch mMatch.StartColumn], mMatch))

| IgnoreWithWarning ->
mkUnit g mMatch

match firstIncompleteMatchClauseWithThrowExpr with
| Some c -> c
| None ->
// We don't emit a sequence point at any of the above cases because they don't correspond to user code.
//
// Note we don't emit sequence points at either the succeeding or failing targets of filters since if
// the exception is filtered successfully then we will run the handler and hit the sequence point there.
// That sequence point will have the pattern variables bound, which is exactly what we want.
let tg = TTarget([], throwExpr, None)
let tg = TTarget([], throwExpr(), None)
let _ = matchBuilder.AddTarget tg
let clause = MatchClause(TPat_wild mMatch, None, tg, mMatch)
incompleteMatchClauseOnce <- Some clause
firstIncompleteMatchClauseWithThrowExpr <- Some clause
clause

| Some c -> c

// Helpers to get the variables bound at a target.
// We conceptually add a dummy clause that will always succeed with a "throw".
let clausesA = Array.ofList clauses
Expand Down
45 changes: 44 additions & 1 deletion tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Simple.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -83,4 +83,47 @@ if res <> "formattable" then
"""
|> asExe
|> compileAndRun
|> shouldSucceed
|> shouldSucceed


[<Fact>]
let ``Enum incompleteness check should not hide an issue with outer DU pattern matching with nowarn:104 `` () =
Fsx """
type E = A = 0

type Ex =
| ExA of int * E
| ExB of int

let flub ex =
match ex with
| ExA(_, E.A) -> ()

flub (ExB 3)
"""
|> withNoWarn 104
|> typecheck
|> shouldFail
|> withDiagnostics [Warning 25, Line 9, Col 11, Line 9, Col 13, "Incomplete pattern matches on this expression. For example, the value 'ExB (_)' may indicate a case not covered by the pattern(s)."]

[<Fact>]
let ``Enum incompleteness check in nested scenarios should report all warnings`` () =
Fsx """
type E =
| FieldA = 1
| FieldB = 2

type U =
| CaseA
| CaseB of E

match CaseA with
| CaseB E.FieldA -> ()
| CaseB E.FieldB -> ()
"""
|> typecheck
|> shouldFail
|> withDiagnostics [
Warning 104, Line 10, Col 7, Line 10, Col 12, "Enums may take values outside known cases. For example, the value 'CaseB (enum<E> (0))' may indicate a case not covered by the pattern(s)."
Warning 25, Line 10, Col 7, Line 10, Col 12, "Incomplete pattern matches on this expression. For example, the value 'CaseA' may indicate a case not covered by the pattern(s)."]