@@ -19,6 +19,7 @@ open Microsoft.FSharp.Compiler.Lib
1919
2020exception MatchIncomplete of bool * ( string * bool ) option * range
2121exception RuleNeverMatched of range
22+ exception EnumMatchIncomplete of bool * ( string * bool ) option * range
2223
2324type ActionOnFailure =
2425 | ThrowIncompleteMatchException
@@ -177,33 +178,37 @@ let RefuteDiscrimSet g m path discrims =
177178 | PathConj ( p,_ j) ->
178179 go p tm
179180 | PathTuple ( p, tys, j) ->
180- go p ( fun _ -> mkRefTupled g m ( mkOneKnown tm j tys) tys)
181+ let k , eCoversVals = mkOneKnown tm j tys
182+ go p ( fun _ -> mkRefTupled g m k tys, eCoversVals)
181183 | PathRecd ( p, tcref, tinst, j) ->
182- let flds = tcref |> actualTysOfInstanceRecdFields ( mkTyconRefInst tcref tinst) |> mkOneKnown tm j
183- go p ( fun _ -> Expr.Op( TOp.Recd( RecdExpr, tcref), tinst, flds, m))
184+ let flds , eCoversVals = tcref |> actualTysOfInstanceRecdFields ( mkTyconRefInst tcref tinst) |> mkOneKnown tm j
185+ go p ( fun _ -> Expr.Op( TOp.Recd( RecdExpr, tcref), tinst, flds, m), eCoversVals )
184186
185187 | PathUnionConstr ( p, ucref, tinst, j) ->
186- let flds = ucref |> actualTysOfUnionCaseFields ( mkTyconRefInst ucref.TyconRef tinst)|> mkOneKnown tm j
187- go p ( fun _ -> Expr.Op( TOp.UnionCase( ucref), tinst, flds, m))
188+ let flds , eCoversVals = ucref |> actualTysOfUnionCaseFields ( mkTyconRefInst ucref.TyconRef tinst)|> mkOneKnown tm j
189+ go p ( fun _ -> Expr.Op( TOp.UnionCase( ucref), tinst, flds, m), eCoversVals )
188190
189191 | PathArray ( p, ty, len, n) ->
190- go p ( fun _ -> Expr.Op( TOp.Array,[ ty], mkOneKnown tm n ( List.replicate len ty) , m))
192+ let flds , eCoversVals = mkOneKnown tm n ( List.replicate len ty)
193+ go p ( fun _ -> Expr.Op( TOp.Array,[ ty], flds , m), eCoversVals)
191194
192195 | PathExnConstr ( p, ecref, n) ->
193- let flds = ecref |> recdFieldTysOfExnDefRef |> mkOneKnown tm n
194- go p ( fun _ -> Expr.Op( TOp.ExnConstr( ecref),[], flds, m))
196+ let flds , eCoversVals = ecref |> recdFieldTysOfExnDefRef |> mkOneKnown tm n
197+ go p ( fun _ -> Expr.Op( TOp.ExnConstr( ecref),[], flds, m), eCoversVals )
195198
196199 | PathEmpty( ty) -> tm ty
197200
198- and mkOneKnown tm n tys = List.mapi ( fun i ty -> if i = n then tm ty else mkUnknown ty) tys
199- and mkUnknowns tys = List.map mkUnknown tys
201+ and mkOneKnown tm n tys =
202+ let flds = List.mapi ( fun i ty -> if i = n then tm ty else ( mkUnknown ty, false )) tys
203+ List.map fst flds, List.fold ( fun acc ( _ , eCoversVals ) -> eCoversVals || acc) false flds
204+ and mkUnknowns tys = List.map ( fun x -> mkUnknown x) tys
200205
201206 let tm ty =
202207 match discrims with
203208 | [ DecisionTreeTest.IsNull] ->
204- snd( mkCompGenLocal m notNullText ty)
209+ snd( mkCompGenLocal m notNullText ty), false
205210 | [ DecisionTreeTest.IsInst (_,_)] ->
206- snd( mkCompGenLocal m otherSubtypeText ty)
211+ snd( mkCompGenLocal m otherSubtypeText ty), false
207212 | ( DecisionTreeTest.Const c :: rest) ->
208213 let consts = Set.ofList ( c :: List.choose ( function DecisionTreeTest.Const( c) -> Some c | _ -> None) rest)
209214 let c ' =
@@ -227,12 +232,23 @@ let RefuteDiscrimSet g m path discrims =
227232 | Const.Decimal _ -> seq { 1 .. System.Int32.MaxValue } |> Seq.map ( fun v -> Const.Decimal( decimal v))
228233 | _ ->
229234 raise CannotRefute)
235+
236+ let coversKnownEnumValues =
237+ match tryDestAppTy g ty with
238+ | Some tcref when tcref.IsEnumTycon ->
239+ let knownValues =
240+ tcref.AllFieldsArray |> Array.choose ( fun f ->
241+ match f.rfield_ const, f.rfield_ static with
242+ | Some value, true -> Some value
243+ | _, _ -> None)
244+ Array.forall ( fun ev -> consts.Contains ev) knownValues
245+ | _ -> false
230246
231247 (* REVIEW: we could return a better enumeration literal field here if a field matches one of the enumeration cases *)
232248
233249 match c' with
234250 | None -> raise CannotRefute
235- | Some c -> Expr.Const( c, m, ty)
251+ | Some c -> Expr.Const( c, m, ty), coversKnownEnumValues
236252
237253 | ( DecisionTreeTest.UnionCase ( ucref1, tinst) :: rest) ->
238254 let ucrefs = ucref1 :: List.choose ( function DecisionTreeTest.UnionCase( ucref,_) -> Some ucref | _ -> None) rest
@@ -246,10 +262,10 @@ let RefuteDiscrimSet g m path discrims =
246262 | [] -> raise CannotRefute
247263 | ucref2 :: _ ->
248264 let flds = ucref2 |> actualTysOfUnionCaseFields ( mkTyconRefInst tcref tinst) |> mkUnknowns
249- Expr.Op( TOp.UnionCase( ucref2), tinst, flds, m)
265+ Expr.Op( TOp.UnionCase( ucref2), tinst, flds, m), false
250266
251267 | [ DecisionTreeTest.ArrayLength ( n, ty)] ->
252- Expr.Op( TOp.Array,[ ty], mkUnknowns ( List.replicate ( n+ 1 ) ty) , m)
268+ Expr.Op( TOp.Array,[ ty], mkUnknowns ( List.replicate ( n+ 1 ) ty) , m), false
253269
254270 | _ ->
255271 raise CannotRefute
@@ -302,15 +318,16 @@ let rec CombineRefutations g r1 r2 =
302318let ShowCounterExample g denv m refuted =
303319 try
304320 let refutations = refuted |> List.collect ( function RefutedWhenClause -> [] | ( RefutedInvestigation( path, discrim)) -> [ RefuteDiscrimSet g m path discrim])
305- let counterExample =
321+ let counterExample , enumCoversKnown =
306322 match refutations with
307323 | [] -> raise CannotRefute
308- | h :: t ->
309- if verbose then dprintf " h = %s \n " ( Layout.showL ( exprL h))
310- List.fold ( CombineRefutations g) h t
324+ | ( r, eck) :: t ->
325+ if verbose then dprintf " r = %s (enumCoversKnownValue = %b )\n " ( Layout.showL ( exprL r)) eck
326+ List.fold ( fun ( rAcc , eckAcc ) ( r , eck ) ->
327+ CombineRefutations g rAcc r, eckAcc || eck) ( r, eck) t
311328 let text = Layout.showL ( NicePrint.dataExprL denv counterExample)
312329 let failingWhenClause = refuted |> List.exists ( function RefutedWhenClause -> true | _ -> false )
313- Some( text, failingWhenClause)
330+ Some( text, failingWhenClause, enumCoversKnown )
314331
315332 with
316333 | CannotRefute ->
@@ -689,10 +706,15 @@ let CompilePatternBasic
689706 (* Emit the incomplete match warning *)
690707 if warnOnIncomplete then
691708 match actionOnFailure with
692- | ThrowIncompleteMatchException ->
693- warning ( MatchIncomplete ( false , ShowCounterExample g denv matchm refuted, matchm))
694- | IgnoreWithWarning ->
695- warning ( MatchIncomplete ( true , ShowCounterExample g denv matchm refuted, matchm))
709+ | ThrowIncompleteMatchException | IgnoreWithWarning ->
710+ let ignoreWithWarning = ( actionOnFailure = IgnoreWithWarning)
711+ match ShowCounterExample g denv matchm refuted with
712+ | Some( text, failingWhenClause, true ) ->
713+ warning ( EnumMatchIncomplete( ignoreWithWarning, Some( text, failingWhenClause), matchm))
714+ | Some( text, failingWhenClause, false ) ->
715+ warning ( MatchIncomplete( ignoreWithWarning, Some( text, failingWhenClause), matchm))
716+ | None ->
717+ warning ( MatchIncomplete( ignoreWithWarning, None, matchm))
696718 | _ ->
697719 ()
698720
0 commit comments