From a0522449b566040b996a7a784bc9aff218cc6fb9 Mon Sep 17 00:00:00 2001 From: jwosty Date: Wed, 14 Mar 2018 14:40:57 -0500 Subject: [PATCH 01/18] Add compiler warning for enum matches --- src/fsharp/CompileOps.fs | 11 +++++++ src/fsharp/FSStrings.resx | 3 ++ src/fsharp/PatternMatchCompilation.fs | 45 +++++++++++++++++--------- src/fsharp/PatternMatchCompilation.fsi | 1 + 4 files changed, 45 insertions(+), 15 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 069dba4859e..a97df640227 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -354,6 +354,7 @@ let GetDiagnosticNumber(err:PhasedDiagnostic) = | ExtensionTyping.ProvidedTypeResolutionNoRange _ | ExtensionTyping.ProvidedTypeResolution _ -> 103 #endif + | PatternMatchCompilation.EnumMatchIncomplete _ -> 104 (* DO NOT CHANGE THE NUMBERS *) // Strip TargetInvocationException wrappers @@ -559,6 +560,7 @@ let MatchIncomplete2E() = DeclareResourceString("MatchIncomplete2", "%s") let MatchIncomplete3E() = DeclareResourceString("MatchIncomplete3", "%s") let MatchIncomplete4E() = DeclareResourceString("MatchIncomplete4", "") let RuleNeverMatchedE() = DeclareResourceString("RuleNeverMatched", "") +let EnumMatchIncomplete1E() = DeclareResourceString("EnumMatchIncomplete1", "") let ValNotMutableE() = DeclareResourceString("ValNotMutable", "%s") let ValNotLocalE() = DeclareResourceString("ValNotLocal", "") let Obsolete1E() = DeclareResourceString("Obsolete1", "") @@ -1401,6 +1403,15 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = if isComp then os.Append(MatchIncomplete4E().Format) |> ignore + | PatternMatchCompilation.EnumMatchIncomplete (isComp, cexOpt, _) -> + os.Append(EnumMatchIncomplete1E().Format) |> ignore + match cexOpt with + | None -> () + | Some (cex, false) -> os.Append(MatchIncomplete2E().Format cex) |> ignore + | Some (cex, true) -> os.Append(MatchIncomplete3E().Format cex) |> ignore + if isComp then + os.Append(MatchIncomplete4E().Format) |> ignore + | PatternMatchCompilation.RuleNeverMatched _ -> os.Append(RuleNeverMatchedE().Format) |> ignore | ValNotMutable(_, valRef, _) -> os.Append(ValNotMutableE().Format(valRef.DisplayName)) |> ignore diff --git a/src/fsharp/FSStrings.resx b/src/fsharp/FSStrings.resx index eb8a8f975cf..2a3e67d4f35 100644 --- a/src/fsharp/FSStrings.resx +++ b/src/fsharp/FSStrings.resx @@ -957,6 +957,9 @@ {0} + + Enums may take values outside known cases. + Incomplete pattern matches on this expression. diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index a40292a3565..e8fe28dd95f 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -19,6 +19,7 @@ open Microsoft.FSharp.Compiler.Lib exception MatchIncomplete of bool * (string * bool) option * range exception RuleNeverMatched of range +exception EnumMatchIncomplete of bool * (string * bool) option * range type ActionOnFailure = | ThrowIncompleteMatchException @@ -308,13 +309,17 @@ let ShowCounterExample g denv m refuted = | h :: t -> if verbose then dprintf "h = %s\n" (Layout.showL (exprL h)) List.fold (CombineRefutations g) h t + //let isEnumCase = + //match counterExample with + //| Expr.Const _ -> true + //| _ -> false let text = Layout.showL (NicePrint.dataExprL denv counterExample) let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false) Some(text,failingWhenClause) with | CannotRefute -> - None + None | e -> warning(InternalError(sprintf "" (e.ToString()),m)) None @@ -681,19 +686,29 @@ let CompilePatternBasic // Add the incomplete or rethrow match clause on demand, printing a // warning if necessary (only if it is ever exercised) let incompleteMatchClauseOnce = ref None - let getIncompleteMatchClause (refuted) = + 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 *) + (* Emit the incomplete match warning *) if warnOnIncomplete then - match actionOnFailure with - | ThrowIncompleteMatchException -> - warning (MatchIncomplete (false,ShowCounterExample g denv matchm refuted, matchm)) - | IgnoreWithWarning -> - warning (MatchIncomplete (true,ShowCounterExample g denv matchm refuted, matchm)) - | _ -> + //let mkIncompleteMatchExn = if isEnum then EnumMatchIncomplete else MatchIncomplete + + match actionOnFailure with + | ThrowIncompleteMatchException -> + let ce = ShowCounterExample g denv matchm refuted + if isEnumTy g topv.val_type then + warning (EnumMatchIncomplete(false, ce, matchm)) + else + warning (MatchIncomplete(false, ce, matchm)) + | IgnoreWithWarning -> + let ce = ShowCounterExample g denv matchm refuted + if isEnumTy g topv.val_type then + warning (EnumMatchIncomplete(true, ce, matchm)) + else + warning (MatchIncomplete(true, ce, matchm)) + | _ -> () let throwExpr = @@ -741,10 +756,10 @@ let CompilePatternBasic // 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 clausesL let nclauses = clausesA.Length - let GetClause i refuted = - if i < nclauses then - clausesA.[i] - elif i = nclauses then getIncompleteMatchClause(refuted) + let GetClause i refuted = + if i < nclauses then + clausesA.[i] + elif i = nclauses then getIncompleteMatchClause refuted else failwith "GetClause" let GetValsBoundByClause i refuted = (GetClause i refuted).BoundVals let GetWhenGuardOfClause i refuted = (GetClause i refuted).GuardExpr @@ -808,14 +823,14 @@ let CompilePatternBasic and CompileSuccessPointAndGuard i refuted valMap rest = let vs2 = GetValsBoundByClause i refuted - let es2 = + let es2 = vs2 |> List.map (fun v -> match valMap.TryFind v with | None -> error(Error(FSComp.SR.patcMissingVariable(v.DisplayName),v.Range)) | Some res -> res) let rhs' = TDSuccess(es2, i) match GetWhenGuardOfClause i refuted with - | Some whenExpr -> + | Some whenExpr -> let m = whenExpr.Range diff --git a/src/fsharp/PatternMatchCompilation.fsi b/src/fsharp/PatternMatchCompilation.fsi index f2cbce1e993..160396caf04 100644 --- a/src/fsharp/PatternMatchCompilation.fsi +++ b/src/fsharp/PatternMatchCompilation.fsi @@ -67,3 +67,4 @@ val internal CompilePattern : exception internal MatchIncomplete of bool * (string * bool) option * range exception internal RuleNeverMatched of range +exception internal EnumMatchIncomplete of bool * (string * bool) option * range \ No newline at end of file From 22ece71f3f41670a20537c03ac38d9a979832cdd Mon Sep 17 00:00:00 2001 From: jwosty Date: Wed, 14 Mar 2018 15:27:24 -0500 Subject: [PATCH 02/18] Refactor --- src/fsharp/PatternMatchCompilation.fs | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index e8fe28dd95f..43957141536 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -692,24 +692,16 @@ let CompilePatternBasic match !incompleteMatchClauseOnce with | None -> (* Emit the incomplete match warning *) - if warnOnIncomplete then - //let mkIncompleteMatchExn = if isEnum then EnumMatchIncomplete else MatchIncomplete - + if warnOnIncomplete then match actionOnFailure with - | ThrowIncompleteMatchException -> - let ce = ShowCounterExample g denv matchm refuted - if isEnumTy g topv.val_type then - warning (EnumMatchIncomplete(false, ce, matchm)) - else - warning (MatchIncomplete(false, ce, matchm)) - | IgnoreWithWarning -> + | ThrowIncompleteMatchException | IgnoreWithWarning -> + let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning) let ce = ShowCounterExample g denv matchm refuted if isEnumTy g topv.val_type then - warning (EnumMatchIncomplete(true, ce, matchm)) + warning (EnumMatchIncomplete(ignoreWithWarning, ce, matchm)) else - warning (MatchIncomplete(true, ce, matchm)) - | _ -> - () + warning (MatchIncomplete(ignoreWithWarning, ce, matchm)) + | _ -> () let throwExpr = match actionOnFailure with From 438242c87e18545803e977b1d41a952f0e57b290 Mon Sep 17 00:00:00 2001 From: jwosty Date: Wed, 14 Mar 2018 17:12:16 -0500 Subject: [PATCH 03/18] Make incomplete enum match warning only show itself when the pattern match covers all known enum values --- src/fsharp/PatternMatchCompilation.fs | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 43957141536..9027081dab2 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -309,10 +309,6 @@ let ShowCounterExample g denv m refuted = | h :: t -> if verbose then dprintf "h = %s\n" (Layout.showL (exprL h)) List.fold (CombineRefutations g) h t - //let isEnumCase = - //match counterExample with - //| Expr.Const _ -> true - //| _ -> false let text = Layout.showL (NicePrint.dataExprL denv counterExample) let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false) Some(text,failingWhenClause) @@ -697,9 +693,22 @@ let CompilePatternBasic | ThrowIncompleteMatchException | IgnoreWithWarning -> let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning) let ce = ShowCounterExample g denv matchm refuted - if isEnumTy g topv.val_type then - warning (EnumMatchIncomplete(ignoreWithWarning, ce, matchm)) - else + match tryDestAppTy g topv.val_type, refuted with + | Some tcref, [RefutedInvestigation(_, decisionTreeTests)] when tcref.IsEnumTycon -> + // Check whether or not the match handles all the defined values for the enum -- this + // changes what warning is emitted + let enumValues = + tcref.AllFieldsArray + |> Array.choose (fun f -> + match f.rfield_const, f.rfield_static with + | Some value, true -> Some value + | _, _ -> None) + let consts = Set.ofList (List.choose (function DecisionTreeTest.Const(c) -> Some c | _ -> None) decisionTreeTests) + if enumValues |> Seq.forall (fun c -> consts.Contains c) then + warning (EnumMatchIncomplete(ignoreWithWarning, ce, matchm)) + else + warning (MatchIncomplete(ignoreWithWarning, ce, matchm)) + | _ -> warning (MatchIncomplete(ignoreWithWarning, ce, matchm)) | _ -> () From 99f77c446b21c1c4a62a4390844bc411696c7c8d Mon Sep 17 00:00:00 2001 From: jwosty Date: Wed, 14 Mar 2018 17:22:16 -0500 Subject: [PATCH 04/18] small change --- src/fsharp/PatternMatchCompilation.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 9027081dab2..d08bdfe3b11 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -694,7 +694,8 @@ let CompilePatternBasic let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning) let ce = ShowCounterExample g denv matchm refuted match tryDestAppTy g topv.val_type, refuted with - | Some tcref, [RefutedInvestigation(_, decisionTreeTests)] when tcref.IsEnumTycon -> + //| Some tcref, [RefutedInvestigation(_, decisionTreeTests)] when tcref.IsEnumTycon -> + | Some tcref, ds when tcref.IsEnumTycon -> // Check whether or not the match handles all the defined values for the enum -- this // changes what warning is emitted let enumValues = @@ -703,6 +704,9 @@ let CompilePatternBasic match f.rfield_const, f.rfield_static with | Some value, true -> Some value | _, _ -> None) + let decisionTreeTests = + ds |> List.collect (function | RefutedInvestigation(_,decisionTreeTests) -> decisionTreeTests + | _ -> []) let consts = Set.ofList (List.choose (function DecisionTreeTest.Const(c) -> Some c | _ -> None) decisionTreeTests) if enumValues |> Seq.forall (fun c -> consts.Contains c) then warning (EnumMatchIncomplete(ignoreWithWarning, ce, matchm)) From 2fb87c4b54bff81866e96fd1e6d0bc318e0ebcf8 Mon Sep 17 00:00:00 2001 From: jwosty Date: Thu, 15 Mar 2018 00:25:47 -0500 Subject: [PATCH 05/18] Update xlf --- src/fsharp/FSStrings.resx | 6 +++--- src/fsharp/xlf/FSStrings.cs.xlf | 5 +++++ src/fsharp/xlf/FSStrings.de.xlf | 5 +++++ src/fsharp/xlf/FSStrings.en.xlf | 4 ++++ src/fsharp/xlf/FSStrings.es.xlf | 5 +++++ src/fsharp/xlf/FSStrings.fr.xlf | 5 +++++ src/fsharp/xlf/FSStrings.it.xlf | 5 +++++ src/fsharp/xlf/FSStrings.ja.xlf | 5 +++++ src/fsharp/xlf/FSStrings.ko.xlf | 5 +++++ src/fsharp/xlf/FSStrings.pl.xlf | 5 +++++ src/fsharp/xlf/FSStrings.pt-BR.xlf | 5 +++++ src/fsharp/xlf/FSStrings.ru.xlf | 5 +++++ src/fsharp/xlf/FSStrings.tr.xlf | 5 +++++ src/fsharp/xlf/FSStrings.zh-Hans.xlf | 5 +++++ src/fsharp/xlf/FSStrings.zh-Hant.xlf | 5 +++++ 15 files changed, 72 insertions(+), 3 deletions(-) diff --git a/src/fsharp/FSStrings.resx b/src/fsharp/FSStrings.resx index 2a3e67d4f35..bdbe391db2a 100644 --- a/src/fsharp/FSStrings.resx +++ b/src/fsharp/FSStrings.resx @@ -957,9 +957,6 @@ {0} - - Enums may take values outside known cases. - Incomplete pattern matches on this expression. @@ -972,6 +969,9 @@ Unmatched elements will be ignored. + + Enums may take values outside known cases. + This rule will never be matched diff --git a/src/fsharp/xlf/FSStrings.cs.xlf b/src/fsharp/xlf/FSStrings.cs.xlf index 90e272e863b..c14aa5fdc1b 100644 --- a/src/fsharp/xlf/FSStrings.cs.xlf +++ b/src/fsharp/xlf/FSStrings.cs.xlf @@ -1422,6 +1422,11 @@ Nespárované prvky se budou ignorovat. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Pro toto pravidlo nebude nikdy existovat shoda. diff --git a/src/fsharp/xlf/FSStrings.de.xlf b/src/fsharp/xlf/FSStrings.de.xlf index 1c98a1cdb01..87f04673c2b 100644 --- a/src/fsharp/xlf/FSStrings.de.xlf +++ b/src/fsharp/xlf/FSStrings.de.xlf @@ -1422,6 +1422,11 @@ Nicht zugeordnete Elemente werden ignoriert. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Für diese Regel wird niemals eine Übereinstimmung gefunden. diff --git a/src/fsharp/xlf/FSStrings.en.xlf b/src/fsharp/xlf/FSStrings.en.xlf index 03bc0887740..77e33bc544d 100644 --- a/src/fsharp/xlf/FSStrings.en.xlf +++ b/src/fsharp/xlf/FSStrings.en.xlf @@ -1421,6 +1421,10 @@ Unmatched elements will be ignored. Unmatched elements will be ignored. + + Enums may take values outside known cases. + Enums may take values outside known cases. + This rule will never be matched diff --git a/src/fsharp/xlf/FSStrings.es.xlf b/src/fsharp/xlf/FSStrings.es.xlf index 986deafbc5c..927b8b95318 100644 --- a/src/fsharp/xlf/FSStrings.es.xlf +++ b/src/fsharp/xlf/FSStrings.es.xlf @@ -1422,6 +1422,11 @@ Los elementos que no coinciden se omitirán. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Nunca se buscarán coincidencias con esta regla. diff --git a/src/fsharp/xlf/FSStrings.fr.xlf b/src/fsharp/xlf/FSStrings.fr.xlf index 4d4cccb39fe..d655b7a2c14 100644 --- a/src/fsharp/xlf/FSStrings.fr.xlf +++ b/src/fsharp/xlf/FSStrings.fr.xlf @@ -1422,6 +1422,11 @@ Les éléments non appariés seront ignorés. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Cette règle n'aura aucune correspondance diff --git a/src/fsharp/xlf/FSStrings.it.xlf b/src/fsharp/xlf/FSStrings.it.xlf index e26f38b3270..dbba7c9e686 100644 --- a/src/fsharp/xlf/FSStrings.it.xlf +++ b/src/fsharp/xlf/FSStrings.it.xlf @@ -1422,6 +1422,11 @@ Gli elementi senza corrispondenza verranno ignorati. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Questa regola non avrà mai alcuna corrispondenza diff --git a/src/fsharp/xlf/FSStrings.ja.xlf b/src/fsharp/xlf/FSStrings.ja.xlf index 7256d1b1a49..d890dcadd95 100644 --- a/src/fsharp/xlf/FSStrings.ja.xlf +++ b/src/fsharp/xlf/FSStrings.ja.xlf @@ -1422,6 +1422,11 @@ 一致しない要素は無視されます。 + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched この規則には一致しません diff --git a/src/fsharp/xlf/FSStrings.ko.xlf b/src/fsharp/xlf/FSStrings.ko.xlf index 2ba29ac4307..778ef3e87c7 100644 --- a/src/fsharp/xlf/FSStrings.ko.xlf +++ b/src/fsharp/xlf/FSStrings.ko.xlf @@ -1422,6 +1422,11 @@ 일치하지 않는 요소는 무시됩니다. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched 이 규칙은 일치시킬 수 없습니다. diff --git a/src/fsharp/xlf/FSStrings.pl.xlf b/src/fsharp/xlf/FSStrings.pl.xlf index d544bdcc32e..71cb306f38b 100644 --- a/src/fsharp/xlf/FSStrings.pl.xlf +++ b/src/fsharp/xlf/FSStrings.pl.xlf @@ -1422,6 +1422,11 @@ Niedopasowane elementy zostaną zignorowane. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Ta reguła nigdy nie zostanie dopasowana diff --git a/src/fsharp/xlf/FSStrings.pt-BR.xlf b/src/fsharp/xlf/FSStrings.pt-BR.xlf index b1dccf3db10..5cdd8cffb0c 100644 --- a/src/fsharp/xlf/FSStrings.pt-BR.xlf +++ b/src/fsharp/xlf/FSStrings.pt-BR.xlf @@ -1422,6 +1422,11 @@ Elementos incompatíveis serão ignorados. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Esta regra nunca será correspondida diff --git a/src/fsharp/xlf/FSStrings.ru.xlf b/src/fsharp/xlf/FSStrings.ru.xlf index bd45c8d8eee..945e8e99aa1 100644 --- a/src/fsharp/xlf/FSStrings.ru.xlf +++ b/src/fsharp/xlf/FSStrings.ru.xlf @@ -1422,6 +1422,11 @@ Элементы без соответствий будут проигнорированы. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Данное правило никогда не будет сопоставлено diff --git a/src/fsharp/xlf/FSStrings.tr.xlf b/src/fsharp/xlf/FSStrings.tr.xlf index 6ce85a3cc4c..eaa5a34841d 100644 --- a/src/fsharp/xlf/FSStrings.tr.xlf +++ b/src/fsharp/xlf/FSStrings.tr.xlf @@ -1422,6 +1422,11 @@ Eşleşmeyen öğeler yok sayılacak. + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched Bu kural hiçbir zaman eşleştirilmeyecek diff --git a/src/fsharp/xlf/FSStrings.zh-Hans.xlf b/src/fsharp/xlf/FSStrings.zh-Hans.xlf index 235affe46bb..940d281ab06 100644 --- a/src/fsharp/xlf/FSStrings.zh-Hans.xlf +++ b/src/fsharp/xlf/FSStrings.zh-Hans.xlf @@ -1422,6 +1422,11 @@ 将忽略不匹配的元素。 + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched 从不与此规则匹配 diff --git a/src/fsharp/xlf/FSStrings.zh-Hant.xlf b/src/fsharp/xlf/FSStrings.zh-Hant.xlf index 90c5a5a8066..d467d0aa239 100644 --- a/src/fsharp/xlf/FSStrings.zh-Hant.xlf +++ b/src/fsharp/xlf/FSStrings.zh-Hant.xlf @@ -1422,6 +1422,11 @@ 無對應的項目將會被忽略。 + + Enums may take values outside known cases. + Enums may take values outside known cases. + + This rule will never be matched 這個規則絕不會比對到 From 6e35f16069559c6505f44f918a29b0dd24c8b37f Mon Sep 17 00:00:00 2001 From: jwosty Date: Thu, 15 Mar 2018 12:13:13 -0500 Subject: [PATCH 06/18] Update xlf (take 2) --- src/fsharp/xlf/FSStrings.cs.xlf | 4 ++-- src/fsharp/xlf/FSStrings.de.xlf | 4 ++-- src/fsharp/xlf/FSStrings.en.xlf | 4 ++-- src/fsharp/xlf/FSStrings.es.xlf | 4 ++-- src/fsharp/xlf/FSStrings.fr.xlf | 4 ++-- src/fsharp/xlf/FSStrings.it.xlf | 4 ++-- src/fsharp/xlf/FSStrings.ja.xlf | 4 ++-- src/fsharp/xlf/FSStrings.ko.xlf | 4 ++-- src/fsharp/xlf/FSStrings.pl.xlf | 4 ++-- src/fsharp/xlf/FSStrings.pt-BR.xlf | 4 ++-- src/fsharp/xlf/FSStrings.ru.xlf | 4 ++-- src/fsharp/xlf/FSStrings.tr.xlf | 4 ++-- src/fsharp/xlf/FSStrings.zh-Hans.xlf | 4 ++-- src/fsharp/xlf/FSStrings.zh-Hant.xlf | 4 ++-- 14 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/fsharp/xlf/FSStrings.cs.xlf b/src/fsharp/xlf/FSStrings.cs.xlf index c14aa5fdc1b..dca4ebffc20 100644 --- a/src/fsharp/xlf/FSStrings.cs.xlf +++ b/src/fsharp/xlf/FSStrings.cs.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.de.xlf b/src/fsharp/xlf/FSStrings.de.xlf index 87f04673c2b..b176c225037 100644 --- a/src/fsharp/xlf/FSStrings.de.xlf +++ b/src/fsharp/xlf/FSStrings.de.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.en.xlf b/src/fsharp/xlf/FSStrings.en.xlf index 77e33bc544d..b9f883ec7e5 100644 --- a/src/fsharp/xlf/FSStrings.en.xlf +++ b/src/fsharp/xlf/FSStrings.en.xlf @@ -1422,8 +1422,8 @@ Unmatched elements will be ignored. - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.es.xlf b/src/fsharp/xlf/FSStrings.es.xlf index 927b8b95318..01fd72c3490 100644 --- a/src/fsharp/xlf/FSStrings.es.xlf +++ b/src/fsharp/xlf/FSStrings.es.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.fr.xlf b/src/fsharp/xlf/FSStrings.fr.xlf index d655b7a2c14..e4ad72e0c56 100644 --- a/src/fsharp/xlf/FSStrings.fr.xlf +++ b/src/fsharp/xlf/FSStrings.fr.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.it.xlf b/src/fsharp/xlf/FSStrings.it.xlf index dbba7c9e686..5b9076d25d1 100644 --- a/src/fsharp/xlf/FSStrings.it.xlf +++ b/src/fsharp/xlf/FSStrings.it.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.ja.xlf b/src/fsharp/xlf/FSStrings.ja.xlf index d890dcadd95..00b44187828 100644 --- a/src/fsharp/xlf/FSStrings.ja.xlf +++ b/src/fsharp/xlf/FSStrings.ja.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.ko.xlf b/src/fsharp/xlf/FSStrings.ko.xlf index 778ef3e87c7..13532832da1 100644 --- a/src/fsharp/xlf/FSStrings.ko.xlf +++ b/src/fsharp/xlf/FSStrings.ko.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.pl.xlf b/src/fsharp/xlf/FSStrings.pl.xlf index 71cb306f38b..6d107fdbbdf 100644 --- a/src/fsharp/xlf/FSStrings.pl.xlf +++ b/src/fsharp/xlf/FSStrings.pl.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.pt-BR.xlf b/src/fsharp/xlf/FSStrings.pt-BR.xlf index 5cdd8cffb0c..0ee36161cd1 100644 --- a/src/fsharp/xlf/FSStrings.pt-BR.xlf +++ b/src/fsharp/xlf/FSStrings.pt-BR.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.ru.xlf b/src/fsharp/xlf/FSStrings.ru.xlf index 945e8e99aa1..de0fe18f6c7 100644 --- a/src/fsharp/xlf/FSStrings.ru.xlf +++ b/src/fsharp/xlf/FSStrings.ru.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.tr.xlf b/src/fsharp/xlf/FSStrings.tr.xlf index eaa5a34841d..ec6013843ef 100644 --- a/src/fsharp/xlf/FSStrings.tr.xlf +++ b/src/fsharp/xlf/FSStrings.tr.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.zh-Hans.xlf b/src/fsharp/xlf/FSStrings.zh-Hans.xlf index 940d281ab06..4ea702daa02 100644 --- a/src/fsharp/xlf/FSStrings.zh-Hans.xlf +++ b/src/fsharp/xlf/FSStrings.zh-Hans.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.zh-Hant.xlf b/src/fsharp/xlf/FSStrings.zh-Hant.xlf index d467d0aa239..4e5725c638b 100644 --- a/src/fsharp/xlf/FSStrings.zh-Hant.xlf +++ b/src/fsharp/xlf/FSStrings.zh-Hant.xlf @@ -1423,8 +1423,8 @@ - Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. + Enums may take values outside known cases. From dd93ded8c241bd23cfe423071ca686f8c765188d Mon Sep 17 00:00:00 2001 From: jwosty Date: Thu, 15 Mar 2018 15:50:01 -0500 Subject: [PATCH 07/18] Fix xlf format mistake --- src/fsharp/xlf/FSStrings.en.xlf | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fsharp/xlf/FSStrings.en.xlf b/src/fsharp/xlf/FSStrings.en.xlf index b9f883ec7e5..af9ffda10a3 100644 --- a/src/fsharp/xlf/FSStrings.en.xlf +++ b/src/fsharp/xlf/FSStrings.en.xlf @@ -1421,6 +1421,7 @@ Unmatched elements will be ignored. Unmatched elements will be ignored. + Enums may take values outside known cases. Enums may take values outside known cases. From 223ee18e8407503d0311741585b05b887c682277 Mon Sep 17 00:00:00 2001 From: jwosty Date: Thu, 15 Mar 2018 16:28:43 -0500 Subject: [PATCH 08/18] Add green test --- src/fsharp/PatternMatchCompilation.fs | 1 + tests/fsharp/typecheck/sigs/neg102.bsl | 10 ++++++++++ tests/fsharp/typecheck/sigs/neg102.fs | 20 ++++++++++++++++++++ 3 files changed, 31 insertions(+) create mode 100644 tests/fsharp/typecheck/sigs/neg102.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg102.fs diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index d08bdfe3b11..9c6a3610702 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -691,6 +691,7 @@ let CompilePatternBasic if warnOnIncomplete then match actionOnFailure with | ThrowIncompleteMatchException | IgnoreWithWarning -> + printfn "%A" refuted let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning) let ce = ShowCounterExample g denv matchm refuted match tryDestAppTy g topv.val_type, refuted with diff --git a/tests/fsharp/typecheck/sigs/neg102.bsl b/tests/fsharp/typecheck/sigs/neg102.bsl new file mode 100644 index 00000000000..b412906b1bc --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg102.bsl @@ -0,0 +1,10 @@ + +neg102.fs(7,14,7,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'enum (1)' may indicate a case not covered by the pattern(s). + +neg102.fs(10,14,10,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'B' may indicate a case not covered by the pattern(s). + +neg102.fs(13,14,13,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s). + +typecheck error FS0104: Enums may take values outside known cases. For example, the value 'enum (2)' may indicate a case not covered by the pattern(s). + + diff --git a/tests/fsharp/typecheck/sigs/neg102.fs b/tests/fsharp/typecheck/sigs/neg102.fs new file mode 100644 index 00000000000..245a0f4acc1 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg102.fs @@ -0,0 +1,20 @@ +module M +type EnumAB = A = 0 | B = 1 +type UnionAB = A | B + +module FS0025 = + // All of these should emit warning FS0025 ("Incomplete pattern match....") + let f1 = function + | EnumAB.A -> "A" + + let f2 = function + | UnionAB.A -> "A" + + let f3 = function + | 42 -> "forty-two" + +module FS0104 = + // These should emit warning FS0104 ("Enums may take values outside of known cases....") + let f1 = function + | EnumAB.A -> "A" + | EnumAB.B -> "B" \ No newline at end of file From 141f713736a5c1683b41a6f8db57c612ee86c054 Mon Sep 17 00:00:00 2001 From: jwosty Date: Fri, 16 Mar 2018 10:52:20 -0500 Subject: [PATCH 09/18] Remove leftover printfn and register test --- src/fsharp/PatternMatchCompilation.fs | 2 -- tests/fsharp/tests.fs | 3 +++ 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 9c6a3610702..637850be4ef 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -691,11 +691,9 @@ let CompilePatternBasic if warnOnIncomplete then match actionOnFailure with | ThrowIncompleteMatchException | IgnoreWithWarning -> - printfn "%A" refuted let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning) let ce = ShowCounterExample g denv matchm refuted match tryDestAppTy g topv.val_type, refuted with - //| Some tcref, [RefutedInvestigation(_, decisionTreeTests)] when tcref.IsEnumTycon -> | Some tcref, ds when tcref.IsEnumTycon -> // Check whether or not the match handles all the defined values for the enum -- this // changes what warning is emitted diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 3c2d9c2d792..cb12953d7ed 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -2162,6 +2162,9 @@ module TypecheckTests = [] let ``type check neg101`` () = singleNegTest (testConfig "typecheck/sigs") "neg101" + [] + let ``type check neg102`` () = singleNegTest (testConfig "typecheck/sigs") "neg102" + [] let ``type check neg_byref_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_byref_1" From 5723f03e3ce39f6e7d6be32b8987fb31a2132598 Mon Sep 17 00:00:00 2001 From: jwosty Date: Sat, 17 Mar 2018 14:38:44 -0500 Subject: [PATCH 10/18] Attempt to make enum warning work in more cases --- src/fsharp/PatternMatchCompilation.fs | 202 ++++++++++++++------------ 1 file changed, 107 insertions(+), 95 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 637850be4ef..48173118e75 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -172,39 +172,48 @@ let otherSubtypeText = "some-other-subtype" exception CannotRefute let RefuteDiscrimSet g m path discrims = let mkUnknown ty = snd(mkCompGenLocal m "_" ty) - let rec go path tm = + let rec go path (tm: TType -> Expr * bool) = match path with | PathQuery _ -> raise CannotRefute | PathConj (p,_j) -> go p tm | PathTuple (p,tys,j) -> - go p (fun _ -> mkRefTupled g m (mkOneKnown tm j tys) tys) + let k, eCoversVals = mkOneKnown tm j tys + go p (fun _ -> mkRefTupled g m k tys, eCoversVals) | PathRecd (p,tcref,tinst,j) -> - let flds = tcref |> actualTysOfInstanceRecdFields (mkTyconRefInst tcref tinst) |> mkOneKnown tm j - go p (fun _ -> Expr.Op(TOp.Recd(RecdExpr, tcref),tinst, flds,m)) + let flds, eCoversVals = tcref |> actualTysOfInstanceRecdFields (mkTyconRefInst tcref tinst) |> mkOneKnown tm j + go p (fun _ -> Expr.Op(TOp.Recd(RecdExpr, tcref),tinst, flds,m), eCoversVals) | PathUnionConstr (p,ucref,tinst,j) -> - let flds = ucref |> actualTysOfUnionCaseFields (mkTyconRefInst ucref.TyconRef tinst)|> mkOneKnown tm j - go p (fun _ -> Expr.Op(TOp.UnionCase(ucref),tinst, flds,m)) + let flds, eCoversVals = ucref |> actualTysOfUnionCaseFields (mkTyconRefInst ucref.TyconRef tinst)|> mkOneKnown tm j + go p (fun _ -> Expr.Op(TOp.UnionCase(ucref),tinst, flds,m), eCoversVals) | PathArray (p,ty,len,n) -> - go p (fun _ -> Expr.Op(TOp.Array,[ty], mkOneKnown tm n (List.replicate len ty) ,m)) + let flds, eCoversVals = mkOneKnown tm n (List.replicate len ty) + go p (fun _ -> Expr.Op(TOp.Array,[ty], flds ,m), eCoversVals) | PathExnConstr (p,ecref,n) -> - let flds = ecref |> recdFieldTysOfExnDefRef |> mkOneKnown tm n - go p (fun _ -> Expr.Op(TOp.ExnConstr(ecref),[], flds,m)) + let flds, eCoversVals = ecref |> recdFieldTysOfExnDefRef |> mkOneKnown tm n + go p (fun _ -> Expr.Op(TOp.ExnConstr(ecref),[], flds,m), eCoversVals) | PathEmpty(ty) -> tm ty - and mkOneKnown tm n tys = List.mapi (fun i ty -> if i = n then tm ty else mkUnknown ty) tys - and mkUnknowns tys = List.map mkUnknown tys + and mkOneKnown tm n tys = + let flds = + tys + |> List.mapi (fun i ty -> + let x: Expr * bool = + if i = n then tm ty else (mkUnknown ty, false) + x) + List.map fst flds, List.fold (fun acc (_, eCoversVals) -> eCoversVals || acc) false flds + and mkUnknowns tys = List.map (fun x -> mkUnknown x) tys let tm ty = match discrims with | [DecisionTreeTest.IsNull] -> - snd(mkCompGenLocal m notNullText ty) + snd(mkCompGenLocal m notNullText ty), false | [DecisionTreeTest.IsInst (_,_)] -> - snd(mkCompGenLocal m otherSubtypeText ty) + snd(mkCompGenLocal m otherSubtypeText ty), false | (DecisionTreeTest.Const c :: rest) -> let consts = Set.ofList (c :: List.choose (function DecisionTreeTest.Const(c) -> Some c | _ -> None) rest) let c' = @@ -228,90 +237,107 @@ let RefuteDiscrimSet g m path discrims = | Const.Decimal _ -> seq { 1 .. System.Int32.MaxValue } |> Seq.map (fun v -> Const.Decimal(decimal v)) | _ -> raise CannotRefute) + + let coversKnownEnumValues = + match tryDestAppTy g ty with + | Some tcref when tcref.IsEnumTycon -> + let knownValues = + tcref.AllFieldsArray |> Array.choose (fun f -> + match f.rfield_const, f.rfield_static with + | Some value, true -> Some value + | _, _ -> None) + // enum pattern covers known values when there exist a known value such that consts does not + // contain it + knownValues |> Array.exists (fun ev -> not (consts.Contains ev)) + | _ -> false (* REVIEW: we could return a better enumeration literal field here if a field matches one of the enumeration cases *) match c' with | None -> raise CannotRefute - | Some c -> Expr.Const(c,m,ty) + | Some c -> Expr.Const(c,m,ty), coversKnownEnumValues | (DecisionTreeTest.UnionCase (ucref1,tinst) :: rest) -> - let ucrefs = ucref1 :: List.choose (function DecisionTreeTest.UnionCase(ucref,_) -> Some ucref | _ -> None) rest - let tcref = ucref1.TyconRef - (* Choose the first ucref based on ordering of names *) - let others = - tcref.UnionCasesAsRefList - |> List.filter (fun ucref -> not (List.exists (g.unionCaseRefEq ucref) ucrefs)) - |> List.sortBy (fun ucref -> ucref.CaseName) - match others with - | [] -> raise CannotRefute - | ucref2 :: _ -> - let flds = ucref2 |> actualTysOfUnionCaseFields (mkTyconRefInst tcref tinst) |> mkUnknowns - Expr.Op(TOp.UnionCase(ucref2),tinst, flds,m) - + let ucrefs = ucref1 :: List.choose (function DecisionTreeTest.UnionCase(ucref,_) -> Some ucref | _ -> None) rest + let tcref = ucref1.TyconRef + (* Choose the first ucref based on ordering of names *) + let others = + tcref.UnionCasesAsRefList + |> List.filter (fun ucref -> not (List.exists (g.unionCaseRefEq ucref) ucrefs)) + |> List.sortBy (fun ucref -> ucref.CaseName) + match others with + | [] -> raise CannotRefute + | ucref2 :: _ -> + let flds = ucref2 |> actualTysOfUnionCaseFields (mkTyconRefInst tcref tinst) |> mkUnknowns + Expr.Op(TOp.UnionCase(ucref2),tinst, flds,m), false + | [DecisionTreeTest.ArrayLength (n,ty)] -> - Expr.Op(TOp.Array,[ty], mkUnknowns (List.replicate (n+1) ty) ,m) + Expr.Op(TOp.Array,[ty], mkUnknowns (List.replicate (n+1) ty) ,m), false | _ -> raise CannotRefute go path tm let rec CombineRefutations g r1 r2 = - match r1,r2 with - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = "_" -> other - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = notNullText -> other - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = otherSubtypeText -> other + match r1,r2 with + | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = "_" -> other + | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = notNullText -> other + | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = otherSubtypeText -> other - | Expr.Op((TOp.ExnConstr(ecref1) as op1), tinst1,flds1,m1), Expr.Op(TOp.ExnConstr(ecref2), _,flds2,_) when tyconRefEq g ecref1 ecref2 -> + | Expr.Op((TOp.ExnConstr(ecref1) as op1), tinst1,flds1,m1), Expr.Op(TOp.ExnConstr(ecref2), _,flds2,_) when tyconRefEq g ecref1 ecref2 -> Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) - | Expr.Op((TOp.UnionCase(ucref1) as op1), tinst1,flds1,m1), - Expr.Op(TOp.UnionCase(ucref2), _,flds2,_) -> - if g.unionCaseRefEq ucref1 ucref2 then - Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) - (* Choose the greater of the two ucrefs based on name ordering *) - elif ucref1.CaseName < ucref2.CaseName then - r2 - else - r1 + | Expr.Op((TOp.UnionCase(ucref1) as op1), tinst1,flds1,m1), + Expr.Op(TOp.UnionCase(ucref2), _,flds2,_) -> + if g.unionCaseRefEq ucref1 ucref2 then + Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) + (* Choose the greater of the two ucrefs based on name ordering *) + elif ucref1.CaseName < ucref2.CaseName then + r2 + else + r1 - | Expr.Op(op1, tinst1,flds1,m1), Expr.Op(_, _,flds2,_) -> - Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) + | Expr.Op(op1, tinst1,flds1,m1), Expr.Op(_, _,flds2,_) -> + Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) - | Expr.Const(c1, m1, ty1), Expr.Const(c2,_,_) -> - let c12 = - - // Make sure longer strings are greater, not the case in the default ordinal comparison - // This is needed because the individual counter examples make longer strings - let MaxStrings s1 s2 = - let c = compare (String.length s1) (String.length s2) - if c < 0 then s2 - elif c > 0 then s1 - elif s1 < s2 then s2 - else s1 - - match c1,c2 with - | Const.String(s1), Const.String(s2) -> Const.String(MaxStrings s1 s2) - | Const.Decimal(s1), Const.Decimal(s2) -> Const.Decimal(max s1 s2) - | _ -> max c1 c2 + | Expr.Const(c1, m1, ty1), Expr.Const(c2,_,_) -> + let c12 = + + // Make sure longer strings are greater, not the case in the default ordinal comparison + // This is needed because the individual counter examples make longer strings + let MaxStrings s1 s2 = + let c = compare (String.length s1) (String.length s2) + if c < 0 then s2 + elif c > 0 then s1 + elif s1 < s2 then s2 + else s1 + + match c1,c2 with + | Const.String(s1), Const.String(s2) -> Const.String(MaxStrings s1 s2) + | Const.Decimal(s1), Const.Decimal(s2) -> Const.Decimal(max s1 s2) + | _ -> max c1 c2 - (* REVIEW: we could return a better enumeration literal field here if a field matches one of the enumeration cases *) - Expr.Const(c12, m1, ty1) + (* REVIEW: we could return a better enumeration literal field here if a field matches one of the enumeration cases *) + Expr.Const(c12, m1, ty1) - | _ -> r1 + | _ -> r1 let ShowCounterExample g denv m refuted = - try - let refutations = refuted |> List.collect (function RefutedWhenClause -> [] | (RefutedInvestigation(path,discrim)) -> [RefuteDiscrimSet g m path discrim]) - let counterExample = - match refutations with - | [] -> raise CannotRefute - | h :: t -> - if verbose then dprintf "h = %s\n" (Layout.showL (exprL h)) - List.fold (CombineRefutations g) h t - let text = Layout.showL (NicePrint.dataExprL denv counterExample) - let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false) - Some(text,failingWhenClause) + try + let refutations = refuted |> List.collect (function RefutedWhenClause -> [] | (RefutedInvestigation(path,discrim)) -> [RefuteDiscrimSet g m path discrim]) + let counterExample, enumCoversKnown = + match refutations with + | [] -> raise CannotRefute + | (r, eck) :: t -> + if verbose then dprintf "r = %s (enumCoversKnownValue = %b)\n" (Layout.showL (exprL r)) eck + //List.fold (fun (rAcc, eckAcc) r -> + //let rAcc, eck = CombineRefutations g rAcc r + //rAcc, eckAcc || eck) (r, eck) t + List.fold (fun (rAcc, eckAcc) (r, eck) -> + CombineRefutations g rAcc r, eckAcc || eck) (r, eck) t + let text = Layout.showL (NicePrint.dataExprL denv counterExample) + let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false) + Some(text,failingWhenClause,enumCoversKnown) with | CannotRefute -> @@ -692,27 +718,13 @@ let CompilePatternBasic match actionOnFailure with | ThrowIncompleteMatchException | IgnoreWithWarning -> let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning) - let ce = ShowCounterExample g denv matchm refuted - match tryDestAppTy g topv.val_type, refuted with - | Some tcref, ds when tcref.IsEnumTycon -> - // Check whether or not the match handles all the defined values for the enum -- this - // changes what warning is emitted - let enumValues = - tcref.AllFieldsArray - |> Array.choose (fun f -> - match f.rfield_const, f.rfield_static with - | Some value, true -> Some value - | _, _ -> None) - let decisionTreeTests = - ds |> List.collect (function | RefutedInvestigation(_,decisionTreeTests) -> decisionTreeTests - | _ -> []) - let consts = Set.ofList (List.choose (function DecisionTreeTest.Const(c) -> Some c | _ -> None) decisionTreeTests) - if enumValues |> Seq.forall (fun c -> consts.Contains c) then - warning (EnumMatchIncomplete(ignoreWithWarning, ce, matchm)) - else - warning (MatchIncomplete(ignoreWithWarning, ce, matchm)) - | _ -> - warning (MatchIncomplete(ignoreWithWarning, ce, matchm)) + match ShowCounterExample g denv matchm refuted with + | Some(text,failingWhenClause,true) -> + warning (EnumMatchIncomplete(ignoreWithWarning, Some(text,failingWhenClause), matchm)) + | Some(text,failingWhenClause,false) -> + warning (MatchIncomplete(ignoreWithWarning, Some(text,failingWhenClause), matchm)) + | None -> + warning (MatchIncomplete(ignoreWithWarning, None, matchm)) | _ -> () let throwExpr = From aed27b1e72dc174f6e9652835bbf2725360bef21 Mon Sep 17 00:00:00 2001 From: jwosty Date: Sat, 17 Mar 2018 14:49:57 -0500 Subject: [PATCH 11/18] Fix inverted logic mistake --- src/fsharp/PatternMatchCompilation.fs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 48173118e75..84d488e9588 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -246,9 +246,7 @@ let RefuteDiscrimSet g m path discrims = match f.rfield_const, f.rfield_static with | Some value, true -> Some value | _, _ -> None) - // enum pattern covers known values when there exist a known value such that consts does not - // contain it - knownValues |> Array.exists (fun ev -> not (consts.Contains ev)) + Array.forall (fun ev -> consts.Contains ev) knownValues | _ -> false (* REVIEW: we could return a better enumeration literal field here if a field matches one of the enumeration cases *) From 247b44c4dc59ed905a8ba272299982b20a1dd9c9 Mon Sep 17 00:00:00 2001 From: jwosty Date: Sat, 17 Mar 2018 15:09:43 -0500 Subject: [PATCH 12/18] Update tests --- tests/fsharp/typecheck/sigs/neg102.bsl | 8 ++++---- tests/fsharp/typecheck/sigs/neg102.fs | 9 ++++++++- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/tests/fsharp/typecheck/sigs/neg102.bsl b/tests/fsharp/typecheck/sigs/neg102.bsl index b412906b1bc..a8748c9045a 100644 --- a/tests/fsharp/typecheck/sigs/neg102.bsl +++ b/tests/fsharp/typecheck/sigs/neg102.bsl @@ -1,10 +1,10 @@ -neg102.fs(7,14,7,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'enum (1)' may indicate a case not covered by the pattern(s). +\Users\jwostenberg\Code\FSharp\visualfsharp\tests\fsharp\typecheck\sigs\neg102.fs(8,14,8,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'enum (1)' may indicate a case not covered by the pattern(s). -neg102.fs(10,14,10,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'B' may indicate a case not covered by the pattern(s). +\Users\jwostenberg\Code\FSharp\visualfsharp\tests\fsharp\typecheck\sigs\neg102.fs(11,14,11,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'B' may indicate a case not covered by the pattern(s). -neg102.fs(13,14,13,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s). +\Users\jwostenberg\Code\FSharp\visualfsharp\tests\fsharp\typecheck\sigs\neg102.fs(14,14,14,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s). typecheck error FS0104: Enums may take values outside known cases. For example, the value 'enum (2)' may indicate a case not covered by the pattern(s). - +typecheck error FS0104: Enums may take values outside known cases. For example, the value 'Some (enum (2))' may indicate a case not covered by the pattern(s). diff --git a/tests/fsharp/typecheck/sigs/neg102.fs b/tests/fsharp/typecheck/sigs/neg102.fs index 245a0f4acc1..7efb9171763 100644 --- a/tests/fsharp/typecheck/sigs/neg102.fs +++ b/tests/fsharp/typecheck/sigs/neg102.fs @@ -4,6 +4,7 @@ type UnionAB = A | B module FS0025 = // All of these should emit warning FS0025 ("Incomplete pattern match....") + let f1 = function | EnumAB.A -> "A" @@ -15,6 +16,12 @@ module FS0025 = module FS0104 = // These should emit warning FS0104 ("Enums may take values outside of known cases....") + let f1 = function | EnumAB.A -> "A" - | EnumAB.B -> "B" \ No newline at end of file + | EnumAB.B -> "B" + + let f2 = function + | Some(EnumAB.A) -> "A" + | Some(EnumAB.B) -> "B" + | None -> "none" \ No newline at end of file From c00671d5376ae2a442f503bbcb54b6e4c71a5c6c Mon Sep 17 00:00:00 2001 From: jwosty Date: Sat, 17 Mar 2018 21:08:38 -0500 Subject: [PATCH 13/18] Fix enum match warning not producing locations --- src/fsharp/CompileOps.fs | 1 + tests/fsharp/typecheck/sigs/neg102.bsl | 10 +++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index a97df640227..a2bb29d4cc7 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -153,6 +153,7 @@ let GetRangeOfDiagnostic(err:PhasedDiagnostic) = | InterfaceNotRevealed(_, _, m) | WrappedError (_, m) | PatternMatchCompilation.MatchIncomplete (_, _, m) + | PatternMatchCompilation.EnumMatchIncomplete (_, _, m) | PatternMatchCompilation.RuleNeverMatched m | ValNotMutable(_, _, m) | ValNotLocal(_, _, m) diff --git a/tests/fsharp/typecheck/sigs/neg102.bsl b/tests/fsharp/typecheck/sigs/neg102.bsl index a8748c9045a..2ef6680cd02 100644 --- a/tests/fsharp/typecheck/sigs/neg102.bsl +++ b/tests/fsharp/typecheck/sigs/neg102.bsl @@ -1,10 +1,10 @@ -\Users\jwostenberg\Code\FSharp\visualfsharp\tests\fsharp\typecheck\sigs\neg102.fs(8,14,8,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'enum (1)' may indicate a case not covered by the pattern(s). +neg102.fs(8,14,8,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'enum (1)' may indicate a case not covered by the pattern(s). -\Users\jwostenberg\Code\FSharp\visualfsharp\tests\fsharp\typecheck\sigs\neg102.fs(11,14,11,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'B' may indicate a case not covered by the pattern(s). +neg102.fs(11,14,11,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'B' may indicate a case not covered by the pattern(s). -\Users\jwostenberg\Code\FSharp\visualfsharp\tests\fsharp\typecheck\sigs\neg102.fs(14,14,14,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s). +neg102.fs(14,14,14,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s). -typecheck error FS0104: Enums may take values outside known cases. For example, the value 'enum (2)' may indicate a case not covered by the pattern(s). +neg102.fs(20,14,20,22): typecheck error FS0104: Enums may take values outside known cases. For example, the value 'enum (2)' may indicate a case not covered by the pattern(s). -typecheck error FS0104: Enums may take values outside known cases. For example, the value 'Some (enum (2))' may indicate a case not covered by the pattern(s). +neg102.fs(24,14,24,22): typecheck error FS0104: Enums may take values outside known cases. For example, the value 'Some (enum (2))' may indicate a case not covered by the pattern(s). From faaee4ffa7037853a8d5825f5f547a355942cc52 Mon Sep 17 00:00:00 2001 From: jwosty Date: Sat, 17 Mar 2018 21:39:27 -0500 Subject: [PATCH 14/18] New items should use translation state "new" --- src/fsharp/xlf/FSStrings.cs.xlf | 2 +- src/fsharp/xlf/FSStrings.de.xlf | 2 +- src/fsharp/xlf/FSStrings.es.xlf | 2 +- src/fsharp/xlf/FSStrings.fr.xlf | 2 +- src/fsharp/xlf/FSStrings.it.xlf | 2 +- src/fsharp/xlf/FSStrings.ja.xlf | 2 +- src/fsharp/xlf/FSStrings.ko.xlf | 2 +- src/fsharp/xlf/FSStrings.pl.xlf | 2 +- src/fsharp/xlf/FSStrings.pt-BR.xlf | 2 +- src/fsharp/xlf/FSStrings.ru.xlf | 2 +- src/fsharp/xlf/FSStrings.tr.xlf | 2 +- src/fsharp/xlf/FSStrings.zh-Hans.xlf | 2 +- src/fsharp/xlf/FSStrings.zh-Hant.xlf | 4 ++-- 13 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/fsharp/xlf/FSStrings.cs.xlf b/src/fsharp/xlf/FSStrings.cs.xlf index dca4ebffc20..67c7b734576 100644 --- a/src/fsharp/xlf/FSStrings.cs.xlf +++ b/src/fsharp/xlf/FSStrings.cs.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.de.xlf b/src/fsharp/xlf/FSStrings.de.xlf index b176c225037..e29b2908ab5 100644 --- a/src/fsharp/xlf/FSStrings.de.xlf +++ b/src/fsharp/xlf/FSStrings.de.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.es.xlf b/src/fsharp/xlf/FSStrings.es.xlf index 01fd72c3490..806ff3fdc43 100644 --- a/src/fsharp/xlf/FSStrings.es.xlf +++ b/src/fsharp/xlf/FSStrings.es.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.fr.xlf b/src/fsharp/xlf/FSStrings.fr.xlf index e4ad72e0c56..5697902a66d 100644 --- a/src/fsharp/xlf/FSStrings.fr.xlf +++ b/src/fsharp/xlf/FSStrings.fr.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.it.xlf b/src/fsharp/xlf/FSStrings.it.xlf index 5b9076d25d1..f3413f1ec3c 100644 --- a/src/fsharp/xlf/FSStrings.it.xlf +++ b/src/fsharp/xlf/FSStrings.it.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.ja.xlf b/src/fsharp/xlf/FSStrings.ja.xlf index 00b44187828..a56e6c210fd 100644 --- a/src/fsharp/xlf/FSStrings.ja.xlf +++ b/src/fsharp/xlf/FSStrings.ja.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.ko.xlf b/src/fsharp/xlf/FSStrings.ko.xlf index 13532832da1..2d5c7a3e1c1 100644 --- a/src/fsharp/xlf/FSStrings.ko.xlf +++ b/src/fsharp/xlf/FSStrings.ko.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.pl.xlf b/src/fsharp/xlf/FSStrings.pl.xlf index 6d107fdbbdf..3ad66dba418 100644 --- a/src/fsharp/xlf/FSStrings.pl.xlf +++ b/src/fsharp/xlf/FSStrings.pl.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.pt-BR.xlf b/src/fsharp/xlf/FSStrings.pt-BR.xlf index 0ee36161cd1..7a747c6f86b 100644 --- a/src/fsharp/xlf/FSStrings.pt-BR.xlf +++ b/src/fsharp/xlf/FSStrings.pt-BR.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.ru.xlf b/src/fsharp/xlf/FSStrings.ru.xlf index de0fe18f6c7..9c8a69c516b 100644 --- a/src/fsharp/xlf/FSStrings.ru.xlf +++ b/src/fsharp/xlf/FSStrings.ru.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.tr.xlf b/src/fsharp/xlf/FSStrings.tr.xlf index ec6013843ef..3e13a11f720 100644 --- a/src/fsharp/xlf/FSStrings.tr.xlf +++ b/src/fsharp/xlf/FSStrings.tr.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.zh-Hans.xlf b/src/fsharp/xlf/FSStrings.zh-Hans.xlf index 4ea702daa02..2101fdbe005 100644 --- a/src/fsharp/xlf/FSStrings.zh-Hans.xlf +++ b/src/fsharp/xlf/FSStrings.zh-Hans.xlf @@ -1424,7 +1424,7 @@ Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. diff --git a/src/fsharp/xlf/FSStrings.zh-Hant.xlf b/src/fsharp/xlf/FSStrings.zh-Hant.xlf index 4e5725c638b..05a07e93b9d 100644 --- a/src/fsharp/xlf/FSStrings.zh-Hant.xlf +++ b/src/fsharp/xlf/FSStrings.zh-Hant.xlf @@ -1422,9 +1422,9 @@ 無對應的項目將會被忽略。 - + Enums may take values outside known cases. - Enums may take values outside known cases. + Enums may take values outside known cases. From 29f83417d7d83606635c1534c13ffb6de36e6ba2 Mon Sep 17 00:00:00 2001 From: jwosty Date: Sun, 18 Mar 2018 01:28:25 -0500 Subject: [PATCH 15/18] Update a test --- .../PatternMatching/Expression/W_CounterExampleWithEnum02.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/Conformance/PatternMatching/Expression/W_CounterExampleWithEnum02.fs b/tests/fsharpqa/Source/Conformance/PatternMatching/Expression/W_CounterExampleWithEnum02.fs index 0fcb3e090de..cb0e64ccf83 100644 --- a/tests/fsharpqa/Source/Conformance/PatternMatching/Expression/W_CounterExampleWithEnum02.fs +++ b/tests/fsharpqa/Source/Conformance/PatternMatching/Expression/W_CounterExampleWithEnum02.fs @@ -1,6 +1,6 @@ // #Regression #Conformance #PatternMatching // Regression test for DevDiv:198999 ("Warning messages for incomplete matches involving enum types are wrong") -//Incomplete pattern matches on this expression\. For example, the value 'enum \(2\)' may indicate a case not covered by the pattern\(s\)\.$ +//Enums may take values outside known cases\. For example, the value 'enum \(2\)' may indicate a case not covered by the pattern\(s\)\.$ //Incomplete pattern matches on this expression\. For example, the value 'enum \(1\)' may indicate a case not covered by the pattern\(s\)\.$ //Incomplete pattern matches on this expression\. For example, the value 'enum \(1\)' may indicate a case not covered by the pattern\(s\)\.$ //Incomplete pattern matches on this expression\. For example, the value 'enum \(1\)' may indicate a case not covered by the pattern\(s\)\.$ From c4780770bf8454fe0a0baee2445a438eee9fa586 Mon Sep 17 00:00:00 2001 From: jwosty Date: Sun, 18 Mar 2018 13:39:12 -0500 Subject: [PATCH 16/18] Update another test --- .../Conformance/PatternMatching/Simple/E_namedLiberal01.fs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tests/fsharpqa/Source/Conformance/PatternMatching/Simple/E_namedLiberal01.fs b/tests/fsharpqa/Source/Conformance/PatternMatching/Simple/E_namedLiberal01.fs index d306ece633b..2f3ba740856 100644 --- a/tests/fsharpqa/Source/Conformance/PatternMatching/Simple/E_namedLiberal01.fs +++ b/tests/fsharpqa/Source/Conformance/PatternMatching/Simple/E_namedLiberal01.fs @@ -1,8 +1,7 @@ // #Regression #Conformance #PatternMatching -// Match warning when using enum for incomplete match. -// (Even if you use every possible value. +// Match warning when covering all defined values of an enum -//Incomplete pattern matches on this expression +//Enums may take values outside known cases. open System From 074f494309c5aa8ec4a818e4bed97f10e535f2e0 Mon Sep 17 00:00:00 2001 From: jwosty Date: Mon, 19 Mar 2018 13:44:29 -0500 Subject: [PATCH 17/18] Undo changes out of the scope of this PR --- src/fsharp/PatternMatchCompilation.fs | 117 ++++++++++++-------------- 1 file changed, 56 insertions(+), 61 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 84d488e9588..72d01dc3e48 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -172,7 +172,7 @@ let otherSubtypeText = "some-other-subtype" exception CannotRefute let RefuteDiscrimSet g m path discrims = let mkUnknown ty = snd(mkCompGenLocal m "_" ty) - let rec go path (tm: TType -> Expr * bool) = + let rec go path tm = match path with | PathQuery _ -> raise CannotRefute | PathConj (p,_j) -> @@ -199,12 +199,7 @@ let RefuteDiscrimSet g m path discrims = | PathEmpty(ty) -> tm ty and mkOneKnown tm n tys = - let flds = - tys - |> List.mapi (fun i ty -> - let x: Expr * bool = - if i = n then tm ty else (mkUnknown ty, false) - x) + 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 and mkUnknowns tys = List.map (fun x -> mkUnknown x) tys @@ -256,18 +251,18 @@ let RefuteDiscrimSet g m path discrims = | Some c -> Expr.Const(c,m,ty), coversKnownEnumValues | (DecisionTreeTest.UnionCase (ucref1,tinst) :: rest) -> - let ucrefs = ucref1 :: List.choose (function DecisionTreeTest.UnionCase(ucref,_) -> Some ucref | _ -> None) rest - let tcref = ucref1.TyconRef - (* Choose the first ucref based on ordering of names *) - let others = - tcref.UnionCasesAsRefList - |> List.filter (fun ucref -> not (List.exists (g.unionCaseRefEq ucref) ucrefs)) - |> List.sortBy (fun ucref -> ucref.CaseName) - match others with - | [] -> raise CannotRefute - | ucref2 :: _ -> - let flds = ucref2 |> actualTysOfUnionCaseFields (mkTyconRefInst tcref tinst) |> mkUnknowns - Expr.Op(TOp.UnionCase(ucref2),tinst, flds,m), false + let ucrefs = ucref1 :: List.choose (function DecisionTreeTest.UnionCase(ucref,_) -> Some ucref | _ -> None) rest + let tcref = ucref1.TyconRef + (* Choose the first ucref based on ordering of names *) + let others = + tcref.UnionCasesAsRefList + |> List.filter (fun ucref -> not (List.exists (g.unionCaseRefEq ucref) ucrefs)) + |> List.sortBy (fun ucref -> ucref.CaseName) + match others with + | [] -> raise CannotRefute + | ucref2 :: _ -> + let flds = ucref2 |> actualTysOfUnionCaseFields (mkTyconRefInst tcref tinst) |> mkUnknowns + Expr.Op(TOp.UnionCase(ucref2),tinst, flds,m), false | [DecisionTreeTest.ArrayLength (n,ty)] -> Expr.Op(TOp.Array,[ty], mkUnknowns (List.replicate (n+1) ty) ,m), false @@ -277,48 +272,48 @@ let RefuteDiscrimSet g m path discrims = go path tm let rec CombineRefutations g r1 r2 = - match r1,r2 with - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = "_" -> other - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = notNullText -> other - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = otherSubtypeText -> other + match r1,r2 with + | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = "_" -> other + | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = notNullText -> other + | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = otherSubtypeText -> other - | Expr.Op((TOp.ExnConstr(ecref1) as op1), tinst1,flds1,m1), Expr.Op(TOp.ExnConstr(ecref2), _,flds2,_) when tyconRefEq g ecref1 ecref2 -> + | Expr.Op((TOp.ExnConstr(ecref1) as op1), tinst1,flds1,m1), Expr.Op(TOp.ExnConstr(ecref2), _,flds2,_) when tyconRefEq g ecref1 ecref2 -> Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) - | Expr.Op((TOp.UnionCase(ucref1) as op1), tinst1,flds1,m1), - Expr.Op(TOp.UnionCase(ucref2), _,flds2,_) -> - if g.unionCaseRefEq ucref1 ucref2 then - Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) - (* Choose the greater of the two ucrefs based on name ordering *) - elif ucref1.CaseName < ucref2.CaseName then - r2 - else - r1 + | Expr.Op((TOp.UnionCase(ucref1) as op1), tinst1,flds1,m1), + Expr.Op(TOp.UnionCase(ucref2), _,flds2,_) -> + if g.unionCaseRefEq ucref1 ucref2 then + Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) + (* Choose the greater of the two ucrefs based on name ordering *) + elif ucref1.CaseName < ucref2.CaseName then + r2 + else + r1 - | Expr.Op(op1, tinst1,flds1,m1), Expr.Op(_, _,flds2,_) -> - Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) + | Expr.Op(op1, tinst1,flds1,m1), Expr.Op(_, _,flds2,_) -> + Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) - | Expr.Const(c1, m1, ty1), Expr.Const(c2,_,_) -> - let c12 = - - // Make sure longer strings are greater, not the case in the default ordinal comparison - // This is needed because the individual counter examples make longer strings - let MaxStrings s1 s2 = - let c = compare (String.length s1) (String.length s2) - if c < 0 then s2 - elif c > 0 then s1 - elif s1 < s2 then s2 - else s1 - - match c1,c2 with - | Const.String(s1), Const.String(s2) -> Const.String(MaxStrings s1 s2) - | Const.Decimal(s1), Const.Decimal(s2) -> Const.Decimal(max s1 s2) - | _ -> max c1 c2 + | Expr.Const(c1, m1, ty1), Expr.Const(c2,_,_) -> + let c12 = + + // Make sure longer strings are greater, not the case in the default ordinal comparison + // This is needed because the individual counter examples make longer strings + let MaxStrings s1 s2 = + let c = compare (String.length s1) (String.length s2) + if c < 0 then s2 + elif c > 0 then s1 + elif s1 < s2 then s2 + else s1 + + match c1,c2 with + | Const.String(s1), Const.String(s2) -> Const.String(MaxStrings s1 s2) + | Const.Decimal(s1), Const.Decimal(s2) -> Const.Decimal(max s1 s2) + | _ -> max c1 c2 - (* REVIEW: we could return a better enumeration literal field here if a field matches one of the enumeration cases *) - Expr.Const(c12, m1, ty1) + (* REVIEW: we could return a better enumeration literal field here if a field matches one of the enumeration cases *) + Expr.Const(c12, m1, ty1) - | _ -> r1 + | _ -> r1 let ShowCounterExample g denv m refuted = try @@ -339,7 +334,7 @@ let ShowCounterExample g denv m refuted = with | CannotRefute -> - None + None | e -> warning(InternalError(sprintf "" (e.ToString()),m)) None @@ -770,10 +765,10 @@ let CompilePatternBasic // 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 clausesL let nclauses = clausesA.Length - let GetClause i refuted = - if i < nclauses then - clausesA.[i] - elif i = nclauses then getIncompleteMatchClause refuted + let GetClause i refuted = + if i < nclauses then + clausesA.[i] + elif i = nclauses then getIncompleteMatchClause(refuted) else failwith "GetClause" let GetValsBoundByClause i refuted = (GetClause i refuted).BoundVals let GetWhenGuardOfClause i refuted = (GetClause i refuted).GuardExpr @@ -837,14 +832,14 @@ let CompilePatternBasic and CompileSuccessPointAndGuard i refuted valMap rest = let vs2 = GetValsBoundByClause i refuted - let es2 = + let es2 = vs2 |> List.map (fun v -> match valMap.TryFind v with | None -> error(Error(FSComp.SR.patcMissingVariable(v.DisplayName),v.Range)) | Some res -> res) let rhs' = TDSuccess(es2, i) match GetWhenGuardOfClause i refuted with - | Some whenExpr -> + | Some whenExpr -> let m = whenExpr.Range From 269ef99893aae25e126433b088bbb1b75d98fafc Mon Sep 17 00:00:00 2001 From: jwosty Date: Tue, 20 Mar 2018 21:53:48 -0500 Subject: [PATCH 18/18] Undo more whitespace --- src/fsharp/PatternMatchCompilation.fs | 80 +++++++++++++-------------- 1 file changed, 39 insertions(+), 41 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 72d01dc3e48..c2e0c6376dd 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -178,23 +178,23 @@ let RefuteDiscrimSet g m path discrims = | PathConj (p,_j) -> go p tm | PathTuple (p,tys,j) -> - let k, eCoversVals = mkOneKnown tm j tys - go p (fun _ -> mkRefTupled g m k tys, eCoversVals) + let k, eCoversVals = mkOneKnown tm j tys + go p (fun _ -> mkRefTupled g m k tys, eCoversVals) | PathRecd (p,tcref,tinst,j) -> - let flds, eCoversVals = tcref |> actualTysOfInstanceRecdFields (mkTyconRefInst tcref tinst) |> mkOneKnown tm j - go p (fun _ -> Expr.Op(TOp.Recd(RecdExpr, tcref),tinst, flds,m), eCoversVals) + let flds, eCoversVals = tcref |> actualTysOfInstanceRecdFields (mkTyconRefInst tcref tinst) |> mkOneKnown tm j + go p (fun _ -> Expr.Op(TOp.Recd(RecdExpr, tcref),tinst, flds,m), eCoversVals) | PathUnionConstr (p,ucref,tinst,j) -> - let flds, eCoversVals = ucref |> actualTysOfUnionCaseFields (mkTyconRefInst ucref.TyconRef tinst)|> mkOneKnown tm j - go p (fun _ -> Expr.Op(TOp.UnionCase(ucref),tinst, flds,m), eCoversVals) + let flds, eCoversVals = ucref |> actualTysOfUnionCaseFields (mkTyconRefInst ucref.TyconRef tinst)|> mkOneKnown tm j + go p (fun _ -> Expr.Op(TOp.UnionCase(ucref),tinst, flds,m), eCoversVals) | PathArray (p,ty,len,n) -> - let flds, eCoversVals = mkOneKnown tm n (List.replicate len ty) - go p (fun _ -> Expr.Op(TOp.Array,[ty], flds ,m), eCoversVals) + let flds, eCoversVals = mkOneKnown tm n (List.replicate len ty) + go p (fun _ -> Expr.Op(TOp.Array,[ty], flds ,m), eCoversVals) | PathExnConstr (p,ecref,n) -> - let flds, eCoversVals = ecref |> recdFieldTysOfExnDefRef |> mkOneKnown tm n - go p (fun _ -> Expr.Op(TOp.ExnConstr(ecref),[], flds,m), eCoversVals) + let flds, eCoversVals = ecref |> recdFieldTysOfExnDefRef |> mkOneKnown tm n + go p (fun _ -> Expr.Op(TOp.ExnConstr(ecref),[], flds,m), eCoversVals) | PathEmpty(ty) -> tm ty @@ -263,9 +263,9 @@ let RefuteDiscrimSet g m path discrims = | ucref2 :: _ -> let flds = ucref2 |> actualTysOfUnionCaseFields (mkTyconRefInst tcref tinst) |> mkUnknowns Expr.Op(TOp.UnionCase(ucref2),tinst, flds,m), false - + | [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), false | _ -> raise CannotRefute @@ -316,21 +316,18 @@ let rec CombineRefutations g r1 r2 = | _ -> r1 let ShowCounterExample g denv m refuted = - try - let refutations = refuted |> List.collect (function RefutedWhenClause -> [] | (RefutedInvestigation(path,discrim)) -> [RefuteDiscrimSet g m path discrim]) - let counterExample, enumCoversKnown = - match refutations with - | [] -> raise CannotRefute - | (r, eck) :: t -> - if verbose then dprintf "r = %s (enumCoversKnownValue = %b)\n" (Layout.showL (exprL r)) eck - //List.fold (fun (rAcc, eckAcc) r -> - //let rAcc, eck = CombineRefutations g rAcc r - //rAcc, eckAcc || eck) (r, eck) t - List.fold (fun (rAcc, eckAcc) (r, eck) -> - CombineRefutations g rAcc r, eckAcc || eck) (r, eck) t - let text = Layout.showL (NicePrint.dataExprL denv counterExample) - let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false) - Some(text,failingWhenClause,enumCoversKnown) + try + let refutations = refuted |> List.collect (function RefutedWhenClause -> [] | (RefutedInvestigation(path,discrim)) -> [RefuteDiscrimSet g m path discrim]) + let counterExample, enumCoversKnown = + match refutations with + | [] -> raise CannotRefute + | (r, eck) :: t -> + if verbose then dprintf "r = %s (enumCoversKnownValue = %b)\n" (Layout.showL (exprL r)) eck + List.fold (fun (rAcc, eckAcc) (r, eck) -> + CombineRefutations g rAcc r, eckAcc || eck) (r, eck) t + let text = Layout.showL (NicePrint.dataExprL denv counterExample) + let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false) + Some(text,failingWhenClause,enumCoversKnown) with | CannotRefute -> @@ -701,24 +698,25 @@ let CompilePatternBasic // Add the incomplete or rethrow match clause on demand, printing a // warning if necessary (only if it is ever exercised) let incompleteMatchClauseOnce = ref None - let getIncompleteMatchClause refuted = + 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 matchm refuted with - | Some(text,failingWhenClause,true) -> - warning (EnumMatchIncomplete(ignoreWithWarning, Some(text,failingWhenClause), matchm)) - | Some(text,failingWhenClause,false) -> - warning (MatchIncomplete(ignoreWithWarning, Some(text,failingWhenClause), matchm)) - | None -> - warning (MatchIncomplete(ignoreWithWarning, None, matchm)) - | _ -> () + (* Emit the incomplete match warning *) + if warnOnIncomplete then + match actionOnFailure with + | ThrowIncompleteMatchException | IgnoreWithWarning -> + let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning) + match ShowCounterExample g denv matchm refuted with + | Some(text,failingWhenClause,true) -> + warning (EnumMatchIncomplete(ignoreWithWarning, Some(text,failingWhenClause), matchm)) + | Some(text,failingWhenClause,false) -> + warning (MatchIncomplete(ignoreWithWarning, Some(text,failingWhenClause), matchm)) + | None -> + warning (MatchIncomplete(ignoreWithWarning, None, matchm)) + | _ -> + () let throwExpr = match actionOnFailure with