From 347b20901339b7dcca121d4a0bceaa97d649fd27 Mon Sep 17 00:00:00 2001 From: jwosty Date: Sat, 16 Jun 2018 16:00:28 -0600 Subject: [PATCH 1/4] Fix FS104 incorrectly handling non-F# enum values --- src/fsharp/PatternMatchCompilation.fs | 46 ++++++++++++++++++++++----- 1 file changed, 38 insertions(+), 8 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 0705c5c4fbb..9be6f0d5457 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -4,6 +4,7 @@ module internal Microsoft.FSharp.Compiler.PatternMatchCompilation open System.Collections.Generic open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.Range @@ -154,6 +155,24 @@ let rec pathEq p1 p2 = | PathEmpty(_), PathEmpty(_) -> true | _ -> false +//// (Temporarily copy-pasted from TypeChecker.fs) +let TcFieldInit lit = + match lit with + | ILFieldInit.String s -> Const.String s + | ILFieldInit.Null -> Const.Zero + | ILFieldInit.Bool b -> Const.Bool b + | ILFieldInit.Char c -> Const.Char (char (int c)) + | ILFieldInit.Int8 x -> Const.SByte x + | ILFieldInit.Int16 x -> Const.Int16 x + | ILFieldInit.Int32 x -> Const.Int32 x + | ILFieldInit.Int64 x -> Const.Int64 x + | ILFieldInit.UInt8 x -> Const.Byte x + | ILFieldInit.UInt16 x -> Const.UInt16 x + | ILFieldInit.UInt32 x -> Const.UInt32 x + | ILFieldInit.UInt64 x -> Const.UInt64 x + | ILFieldInit.Single f -> Const.Single f + | ILFieldInit.Double f -> Const.Double f + //--------------------------------------------------------------------------- // Counter example generation @@ -238,16 +257,27 @@ let RefuteDiscrimSet g m path discrims = | Some c -> match tryDestAppTy g ty with | Some tcref when tcref.IsEnumTycon -> - // search for an enum value that pattern match (consts) does not contain - let nonCoveredEnumValues = - tcref.AllFieldsArray |> Array.tryFind (fun f -> - match f.rfield_const with - | None -> false - | Some fieldValue -> (not (consts.Contains fieldValue)) && f.rfield_static) + let enumValues = + if tcref.IsILEnumTycon then + let (TILObjectReprData(_, _, tdef)) = tcref.ILTyconInfo + tdef.Fields.AsList + |> Seq.choose (fun ilField -> + if ilField.IsStatic then + ilField.LiteralValue |> Option.map (fun ilValue -> + ilField.Name, TcFieldInit ilValue) + else None) + else + tcref.AllFieldsArray |> Seq.choose (fun fsField -> + match fsField.rfield_const, fsField.rfield_static with + | Some fsFieldValue, true -> Some (fsField.rfield_id.idText, fsFieldValue) + | _ -> None) + + let nonCoveredEnumValues = Seq.tryFind (fun (_, fldValue) -> not (consts.Contains fldValue)) enumValues + match nonCoveredEnumValues with | None -> Expr.Const(c,m,ty), true - | Some f -> - let v = RecdFieldRef.RFRef(tcref, f.rfield_id.idText) + | Some (fldName, _) -> + let v = RecdFieldRef.RFRef(tcref, fldName) Expr.Op(TOp.ValFieldGet v, [ty], [], m), false | _ -> Expr.Const(c,m,ty), false From d8ab424eb4b67e0883f42826a8621cc461912ecf Mon Sep 17 00:00:00 2001 From: jwosty Date: Sat, 16 Jun 2018 16:26:31 -0600 Subject: [PATCH 2/4] Add tests that expose the bug --- tests/fsharp/typecheck/sigs/neg102.bsl | 8 ++++++-- tests/fsharp/typecheck/sigs/neg102.fs | 13 +++++++++++-- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/tests/fsharp/typecheck/sigs/neg102.bsl b/tests/fsharp/typecheck/sigs/neg102.bsl index d428a9e4dff..333f0e34d17 100644 --- a/tests/fsharp/typecheck/sigs/neg102.bsl +++ b/tests/fsharp/typecheck/sigs/neg102.bsl @@ -9,6 +9,10 @@ neg102.fs(18,14,18,22): typecheck error FS0025: Incomplete pattern matches on th neg102.fs(22,14,22,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'Some (EnumABC.C)' may indicate a case not covered by the pattern(s). -neg102.fs(29,14,29,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). +neg102.fs(27,14,27,22): typecheck error FS0025: Incomplete pattern matches on this expression. For example, the value 'System.DateTimeKind.Utc' may indicate a case not covered by the pattern(s). -neg102.fs(34,14,34,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). +neg102.fs(32,14,32,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). + +neg102.fs(37,14,37,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). + +neg102.fs(44,14,44,22): typecheck error FS0104: Enums may take values outside known cases. For example, the value 'enum (3)' 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 4620a55fee7..5eb13cdc79f 100644 --- a/tests/fsharp/typecheck/sigs/neg102.fs +++ b/tests/fsharp/typecheck/sigs/neg102.fs @@ -4,7 +4,7 @@ type UnionAB = A | B module FS0025 = // All of these should emit warning FS0025 ("Incomplete pattern match....") - + let f1 = function | UnionAB.A -> "A" @@ -23,6 +23,9 @@ module FS0025 = | Some(EnumABC.A) | Some(EnumABC.B) -> "A|B" | None -> "neither" + // try a non-F#-defined enum + let f6 = function System.DateTimeKind.Unspecified -> 0 + module FS0104 = // These should emit warning FS0104 ("Enums may take values outside of known cases....") @@ -35,4 +38,10 @@ module FS0104 = | Some(EnumABC.A) -> "A" | Some(EnumABC.B) -> "B" | Some(EnumABC.C) -> "C" - | None -> "none" \ No newline at end of file + | None -> "none" + + // try a non-F#-defined enum + let f3 = function + | System.DateTimeKind.Unspecified -> "Unspecified" + | System.DateTimeKind.Utc -> "Utc" + | System.DateTimeKind.Local -> "Local" \ No newline at end of file From 9723be6337b44f152ea96c0c9c9c57f33436cfa9 Mon Sep 17 00:00:00 2001 From: jwosty Date: Sun, 17 Jun 2018 13:42:58 -0600 Subject: [PATCH 3/4] Refactor TcFieldInit function (formerly duplicated in PatternMatchCompilation) --- src/fsharp/PatternMatchCompilation.fs | 37 +++++++++++++------------- src/fsharp/PatternMatchCompilation.fsi | 3 +++ src/fsharp/TypeChecker.fs | 18 +------------ 3 files changed, 23 insertions(+), 35 deletions(-) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 9be6f0d5457..16c9453f5e0 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -155,8 +155,24 @@ let rec pathEq p1 p2 = | PathEmpty(_), PathEmpty(_) -> true | _ -> false -//// (Temporarily copy-pasted from TypeChecker.fs) -let TcFieldInit lit = + +//--------------------------------------------------------------------------- +// Counter example generation +//--------------------------------------------------------------------------- + +type RefutedSet = + /// A value RefutedInvestigation(path,discrim) indicates that the value at the given path is known + /// to NOT be matched by the given discriminator + | RefutedInvestigation of Path * DecisionTreeTest list + /// A value RefutedWhenClause indicates that a 'when' clause failed + | RefutedWhenClause + +let notNullText = "some-non-null-value" +let otherSubtypeText = "some-other-subtype" + +/// Create a TAST const value from an IL-initialized field read from .NET metadata +// (Originally moved from TcFieldInit in TypeChecker.fs -- feel free to move this somewhere more appropriate) +let ilFieldToTastConst lit = match lit with | ILFieldInit.String s -> Const.String s | ILFieldInit.Null -> Const.Zero @@ -173,21 +189,6 @@ let TcFieldInit lit = | ILFieldInit.Single f -> Const.Single f | ILFieldInit.Double f -> Const.Double f - -//--------------------------------------------------------------------------- -// Counter example generation -//--------------------------------------------------------------------------- - -type RefutedSet = - /// A value RefutedInvestigation(path,discrim) indicates that the value at the given path is known - /// to NOT be matched by the given discriminator - | RefutedInvestigation of Path * DecisionTreeTest list - /// A value RefutedWhenClause indicates that a 'when' clause failed - | RefutedWhenClause - -let notNullText = "some-non-null-value" -let otherSubtypeText = "some-other-subtype" - exception CannotRefute let RefuteDiscrimSet g m path discrims = let mkUnknown ty = snd(mkCompGenLocal m "_" ty) @@ -264,7 +265,7 @@ let RefuteDiscrimSet g m path discrims = |> Seq.choose (fun ilField -> if ilField.IsStatic then ilField.LiteralValue |> Option.map (fun ilValue -> - ilField.Name, TcFieldInit ilValue) + ilField.Name, ilFieldToTastConst ilValue) else None) else tcref.AllFieldsArray |> Seq.choose (fun fsField -> diff --git a/src/fsharp/PatternMatchCompilation.fsi b/src/fsharp/PatternMatchCompilation.fsi index 160396caf04..348f37ae94d 100644 --- a/src/fsharp/PatternMatchCompilation.fsi +++ b/src/fsharp/PatternMatchCompilation.fsi @@ -2,6 +2,7 @@ module internal Microsoft.FSharp.Compiler.PatternMatchCompilation +open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops @@ -42,6 +43,8 @@ and PatternValBinding = and TypedMatchClause = | TClause of Pattern * Expr option * DecisionTreeTarget * range +val ilFieldToTastConst : ILFieldInit -> Tast.Const + /// Compile a pattern into a decision tree and a set of targets. val internal CompilePattern : TcGlobals -> diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index b068a063f35..3bfbd86d196 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -905,23 +905,7 @@ let TcConst cenv ty m env c = | SynConst.Bytes _ -> error (InternalError(FSComp.SR.tcUnexpectedConstByteArray(), m)) /// Convert an Abstract IL ILFieldInit value read from .NET metadata to a TAST constant -let TcFieldInit (_m:range) lit = - match lit with - | ILFieldInit.String s -> Const.String s - | ILFieldInit.Null -> Const.Zero - | ILFieldInit.Bool b -> Const.Bool b - | ILFieldInit.Char c -> Const.Char (char (int c)) - | ILFieldInit.Int8 x -> Const.SByte x - | ILFieldInit.Int16 x -> Const.Int16 x - | ILFieldInit.Int32 x -> Const.Int32 x - | ILFieldInit.Int64 x -> Const.Int64 x - | ILFieldInit.UInt8 x -> Const.Byte x - | ILFieldInit.UInt16 x -> Const.UInt16 x - | ILFieldInit.UInt32 x -> Const.UInt32 x - | ILFieldInit.UInt64 x -> Const.UInt64 x - | ILFieldInit.Single f -> Const.Single f - | ILFieldInit.Double f -> Const.Double f - +let TcFieldInit (_m:range) lit = PatternMatchCompilation.ilFieldToTastConst lit //------------------------------------------------------------------------- // Arities. These serve two roles in the system: From 9885bfd2b8efc1f9dbe0236d5bd3503df32fdacf Mon Sep 17 00:00:00 2001 From: jwosty Date: Sun, 17 Jun 2018 13:49:22 -0600 Subject: [PATCH 4/4] Add a comment --- src/fsharp/PatternMatchCompilation.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 16c9453f5e0..3ffbc94b04e 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -258,6 +258,7 @@ let RefuteDiscrimSet g m path discrims = | Some c -> match tryDestAppTy g ty with | Some tcref when tcref.IsEnumTycon -> + // We must distinguish between F#-defined enums and other .NET enums, as they are represented differently in the TAST let enumValues = if tcref.IsILEnumTycon then let (TILObjectReprData(_, _, tdef)) = tcref.ILTyconInfo