Enum match warning

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) 
@@ -354,6 +355,7 @@ let GetDiagnosticNumber(err:PhasedDiagnostic) =
       | ExtensionTyping.ProvidedTypeResolutionNoRange _
       | ExtensionTyping.ProvidedTypeResolution _ -> 103
 #endif
+      | PatternMatchCompilation.EnumMatchIncomplete _ -> 104
        (* DO NOT CHANGE THE NUMBERS *)
 
       // Strip TargetInvocationException wrappers
@@ -559,6 +561,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 +1404,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

src/fsharp/FSStrings.resx

@@ -969,6 +969,9 @@
   <data name="MatchIncomplete4" xml:space="preserve">
     <value> Unmatched elements will be ignored.</value>
   </data>
+  <data name="EnumMatchIncomplete1" xml:space="preserve">
+    <value>Enums may take values outside known cases.</value>
+  </data>
   <data name="RuleNeverMatched" xml:space="preserve">
     <value>This rule will never be matched</value>
   </data>

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 
@@ -177,33 +178,37 @@ let RefuteDiscrimSet g m path discrims =
         | 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 = 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
 
     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' = 
@@ -227,12 +232,23 @@ 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)
+                    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 *)
 
             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
@@ -246,10 +262,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)
+               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
@@ -302,15 +318,16 @@ let rec CombineRefutations g r1 r2 =
 let ShowCounterExample g denv m refuted = 
    try
       let refutations = refuted |> List.collect (function RefutedWhenClause -> [] | (RefutedInvestigation(path,discrim)) -> [RefuteDiscrimSet g m path discrim])
-      let counterExample = 
+      let counterExample, enumCoversKnown = 
           match refutations with 
           | [] -> raise CannotRefute
-          | h :: t -> 
-              if verbose then dprintf "h = %s\n" (Layout.showL (exprL h))
-              List.fold (CombineRefutations g) h t
+          | (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)
+      Some(text,failingWhenClause,enumCoversKnown)
 
     with 
         | CannotRefute ->    
@@ -689,10 +706,15 @@ let CompilePatternBasic
                 (* 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))
+                   | 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))
                    | _ -> 
                         ()
 

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

src/fsharp/xlf/FSStrings.cs.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Nespárované prvky se budou ignorovat.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Pro toto pravidlo nebude nikdy existovat shoda.</target>

src/fsharp/xlf/FSStrings.de.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Nicht zugeordnete Elemente werden ignoriert.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Für diese Regel wird niemals eine Übereinstimmung gefunden.</target>

src/fsharp/xlf/FSStrings.en.xlf

@@ -1422,6 +1422,11 @@
         <target state="new"> Unmatched elements will be ignored.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="new">This rule will never be matched</target>

src/fsharp/xlf/FSStrings.es.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Los elementos que no coinciden se omitirán.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Nunca se buscarán coincidencias con esta regla.</target>

src/fsharp/xlf/FSStrings.fr.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Les éléments non appariés seront ignorés.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Cette règle n'aura aucune correspondance</target>

src/fsharp/xlf/FSStrings.it.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Gli elementi senza corrispondenza verranno ignorati.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Questa regola non avrà mai alcuna corrispondenza</target>

src/fsharp/xlf/FSStrings.ja.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> 一致しない要素は無視されます。</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">この規則には一致しません</target>

src/fsharp/xlf/FSStrings.ko.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> 일치하지 않는 요소는 무시됩니다.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">이 규칙은 일치시킬 수 없습니다.</target>

src/fsharp/xlf/FSStrings.pl.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Niedopasowane elementy zostaną zignorowane.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Ta reguła nigdy nie zostanie dopasowana</target>

src/fsharp/xlf/FSStrings.pt-BR.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Elementos incompatíveis serão ignorados.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Esta regra nunca será correspondida</target>

src/fsharp/xlf/FSStrings.ru.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Элементы без соответствий будут проигнорированы.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Данное правило никогда не будет сопоставлено</target>

src/fsharp/xlf/FSStrings.tr.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> Eşleşmeyen öğeler yok sayılacak.</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">Bu kural hiçbir zaman eşleştirilmeyecek</target>

src/fsharp/xlf/FSStrings.zh-Hans.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> 将忽略不匹配的元素。</target>
         <note />
       </trans-unit>
+      <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">从不与此规则匹配</target>

src/fsharp/xlf/FSStrings.zh-Hant.xlf

@@ -1422,6 +1422,11 @@
         <target state="translated"> 無對應的項目將會被忽略。</target>
         <note />
       </trans-unit>
+     <trans-unit id="EnumMatchIncomplete1">
+        <source>Enums may take values outside known cases.</source>
+        <target state="new">Enums may take values outside known cases.</target>
+        <note />
+      </trans-unit>
       <trans-unit id="RuleNeverMatched">
         <source>This rule will never be matched</source>
         <target state="translated">這個規則絕不會比對到</target>

tests/fsharp/tests.fs

@@ -2162,6 +2162,9 @@ module TypecheckTests =
     [<Test>] 
     let ``type check neg101`` () = singleNegTest (testConfig "typecheck/sigs") "neg101"
 
+    [<Test>]
+    let ``type check neg102`` () = singleNegTest (testConfig "typecheck/sigs") "neg102"
+
     [<Test>] 
     let ``type check neg_byref_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_byref_1"
 

tests/fsharp/typecheck/sigs/neg102.bsl

@@ -0,0 +1,10 @@
+
+neg102.fs(8,14,8,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'enum<EnumAB> (1)' 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).
+
+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(20,14,20,22): typecheck error FS0104: Enums may take values outside known cases. For example, the value 'enum<EnumAB> (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<EnumAB> (2))' may indicate a case not covered by the pattern(s).