diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 4b40ccf1804..252066f8681 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -595,18 +595,23 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m let mkf, argTys, argNames = ApplyUnionCaseOrExn m cenv env ty item let numArgTys = argTys.Length + let warnOnUnionWithNoData = + g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) let args, extraPatternsFromNames = match args with | SynArgPats.Pats args -> - if g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) then + if warnOnUnionWithNoData then match args with - | [ SynPat.Wild _ ] | [ SynPat.Named _ ] when argNames.IsEmpty -> + | [ SynPat.Wild _ ] when argNames.IsEmpty -> + // Here we only care about the cases where the user has written the wildcard pattern explicitly + // | Case _ -> ... + // let myDiscardedArgFunc(Case _) = ...""" + // This needs to be a waring because it was a valid pattern in version 7.0 and earlier and we don't want to break existing code. + // The rest of the cases will still be reported as FS0725 warning(Error(FSComp.SR.matchNotAllowedForUnionCaseWithNoData(), m)) - args, [] - | _ -> args, [] - else - args, [] + | _ -> () + args, [] | SynArgPats.NamePatPairs (pairs, m, _) -> // rewrite patterns from the form (name-N = pat-N; ...) to (..._, pat-N, _...) // so type T = Case of name: int * value: int @@ -664,12 +669,8 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m | [SynPatErrorSkip(SynPat.Wild _ as e) | SynPatErrorSkip(SynPat.Paren(SynPatErrorSkip(SynPat.Wild _ as e), _))] -> List.replicate numArgTys e, [] | args when numArgTys = 0 -> - if g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) then - [], args - else - errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m)) - [], args - + errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m)) + [], args | arg :: rest when numArgTys = 1 -> if numArgTys = 1 && not (List.isEmpty rest) then errorR (Error (FSComp.SR.tcUnionCaseRequiresOneArgument (), m)) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/E_UnionCaseTakesNoArguments.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/E_UnionCaseTakesNoArguments.fs new file mode 100644 index 00000000000..d918dddde03 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/E_UnionCaseTakesNoArguments.fs @@ -0,0 +1,59 @@ +type A = { X: int } + +type B = | B of int + +type C = | C + +match None with +| None 1 -> () + +match None with +| None (1, 2) -> () + +match None with +| None [] -> () + +match None with +| None [||] -> () + +match None with +| None { X = 1 } -> () + +match None with +| None (B 1) -> () + +match None with +| None (x, y) -> () + +match None with +| None false -> () + +match None with +| None _ -> () // Wildcard pattern raises a warning in F# 8.0 + +match None with +| None x -> () + +match None with +| None (x, y) -> () +| Some _ -> () + +match None with +| None x y -> () +| Some _ -> () + +let c = C + +match c with +| C _ _ -> () + +match c with +| C __ -> () + +let myDiscardedArgFunc(C _) = () // Wildcard pattern raises a warning in F# 8.0 + +let myDiscardedArgFunc2(C c) = () + +let myDiscardedArgFunc3(C __) = 5+5 + +let myDiscardedArgFunc(None x y) = None \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs index fcad42227fb..df94ca89e0e 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs @@ -1,5 +1,6 @@ module ErrorMessages.UnionCasePatternMatchingErrors +open FSharp.Test open Xunit open FSharp.Test.Compiler @@ -86,8 +87,7 @@ let myVal = |> typecheck |> shouldFail |> withSingleDiagnostic (Warning 3548, Line 9, Col 7, Line 9, Col 10, "Pattern discard is not allowed for union case that takes no data.") - - + [] let ``Union Pattern discard allowed for union case that takes no data with Lang version 7`` () = FSharp """ @@ -245,6 +245,30 @@ let myVal = (Warning 3548, Line 17, Col 20, Line 17, Col 23, "Pattern discard is not allowed for union case that takes no data.") ] +[] +let ``Multiple pattern discards not allowed for union case that takes no data with Lang 7`` () = + FSharp """ +module Tests +type U = + | A + | B of int * int * int + | C of int * int * int + +type V = + | D + +let a : U = A +let d : V = D + +let myVal = + match a, d with + | A _, D -> 15 + | B (x, _, _), D _ -> 16 + | C _, _ -> 17""" + |> withLangVersion70 + |> typecheck + |> shouldSucceed + [] let ``Multiple function pattern discards is not allowed for union case that takes no data with Lang preview`` () = FSharp """ @@ -274,42 +298,82 @@ let myVal = ] [] -let ``Pattern discard allowed for single-case unions when using them as a deconstruct syntax in functions with Lang 7`` () = +let ``Multiple function pattern discards is not allowed for union case that takes no data with Lang 7`` () = FSharp """ module Tests -type MyWrapper = A +type U = + | A + | B of int * int * int + | C of int * int * int + +type V = + | D + +let a : U = A -let myDiscardedArgFunc(A _) = 5+5""" +let d : V = D + +let myVal = + function + | A _, D -> 15 + | B (x, _, _), D _ -> 16 + | C _, _ -> 17""" |> withLangVersion70 |> typecheck |> shouldSucceed - -[] -let ``Pattern named not allowed for single-case unions when using them as a deconstruct syntax in functions with Lang 7`` () = - FSharp """ -module Tests -type MyWrapper = A - -let myFunc(A a) = 5+5""" + +[] +let ``Pattern named not allowed union case does not take any arguments with Lang 7`` compilation = + compilation + |> asFs |> withLangVersion70 + |> withOptions ["--nowarn:25"] |> typecheck |> shouldFail |> withDiagnostics [ - (Error 725, Line 5, Col 12, Line 5, Col 15, "This union case does not take arguments") + (Error 725, Line 8, Col 3, Line 8, Col 9, "This union case does not take arguments"); + (Error 725, Line 11, Col 3, Line 11, Col 14, "This union case does not take arguments") + (Error 725, Line 14, Col 3, Line 14, Col 10, "This union case does not take arguments") + (Error 725, Line 17, Col 3, Line 17, Col 12, "This union case does not take arguments") + (Error 725, Line 20, Col 3, Line 20, Col 17, "This union case does not take arguments") + (Error 725, Line 23, Col 3, Line 23, Col 13, "This union case does not take arguments") + (Error 725, Line 26, Col 3, Line 26, Col 14, "This union case does not take arguments") + (Error 725, Line 29, Col 3, Line 29, Col 13, "This union case does not take arguments") + (Error 725, Line 35, Col 3, Line 35, Col 9, "This union case does not take arguments") + (Error 725, Line 38, Col 3, Line 38, Col 14, "This union case does not take arguments") + (Error 725, Line 42, Col 3, Line 42, Col 11, "This union case does not take arguments") + (Error 725, Line 48, Col 3, Line 48, Col 8, "This union case does not take arguments") + (Error 725, Line 51, Col 3, Line 51, Col 7, "This union case does not take arguments") + (Error 725, Line 55, Col 25, Line 55, Col 28, "This union case does not take arguments") + (Error 725, Line 57, Col 25, Line 57, Col 29, "This union case does not take arguments") + (Error 725, Line 59, Col 24, Line 59, Col 32, "This union case does not take arguments") ] - -[] -let ``Pattern discard or named are not allowed for single-case union case that takes no data with Lang preview`` () = - FSharp """ -module Tests -type MyWrapper = A - -let myFunc(A a) = 5+5 -let myDiscardedArgFunc(A _) = 5+5""" + +[] +let ``Pattern named not allowed union case does not take any arguments with Lang preview`` compilation = + compilation + |> asFs |> withLangVersion80 + |> withOptions ["--nowarn:25"] |> typecheck |> shouldFail |> withDiagnostics [ - (Warning 3548, Line 5, Col 12, Line 5, Col 15, "Pattern discard is not allowed for union case that takes no data.") - (Warning 3548, Line 6, Col 24, Line 6, Col 27, "Pattern discard is not allowed for union case that takes no data.") + (Error 725, Line 8, Col 3, Line 8, Col 9, "This union case does not take arguments") + (Error 725, Line 11, Col 3, Line 11, Col 14, "This union case does not take arguments") + (Error 725, Line 14, Col 3, Line 14, Col 10, "This union case does not take arguments") + (Error 725, Line 17, Col 3, Line 17, Col 12, "This union case does not take arguments") + (Error 725, Line 20, Col 3, Line 20, Col 17, "This union case does not take arguments") + (Error 725, Line 23, Col 3, Line 23, Col 13, "This union case does not take arguments") + (Error 725, Line 26, Col 3, Line 26, Col 14, "This union case does not take arguments") + (Error 725, Line 29, Col 3, Line 29, Col 13, "This union case does not take arguments") + (Warning 3548, Line 32, Col 3, Line 32, Col 9, "Pattern discard is not allowed for union case that takes no data.") + (Error 725, Line 35, Col 3, Line 35, Col 9, "This union case does not take arguments") + (Error 725, Line 38, Col 3, Line 38, Col 14, "This union case does not take arguments") + (Error 725, Line 42, Col 3, Line 42, Col 11, "This union case does not take arguments") + (Error 725, Line 48, Col 3, Line 48, Col 8, "This union case does not take arguments") + (Error 725, Line 51, Col 3, Line 51, Col 7, "This union case does not take arguments") + (Warning 3548, Line 53, Col 24, Line 53, Col 27, "Pattern discard is not allowed for union case that takes no data.") + (Error 725, Line 55, Col 25, Line 55, Col 28, "This union case does not take arguments") + (Error 725, Line 57, Col 25, Line 57, Col 29, "This union case does not take arguments") + (Error 725, Line 59, Col 24, Line 59, Col 32, "This union case does not take arguments") ] \ No newline at end of file diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index f64b72c4662..996cb4c2dcf 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -134,7 +134,7 @@ match A with """ assertHasSymbolUsages ["x"; "y"] checkResults dumpDiagnostics checkResults |> shouldEqual [ - "(7,2--7,5): Pattern discard is not allowed for union case that takes no data." + "(7,2--7,5): This union case does not take arguments" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'B (_)' may indicate a case not covered by the pattern(s)." ] diff --git a/vsintegration/tests/FSharp.Editor.Tests/CodeFixes/RemoveSuperfluousCaptureForUnionCaseWithNoDataTests.fs b/vsintegration/tests/FSharp.Editor.Tests/CodeFixes/RemoveSuperfluousCaptureForUnionCaseWithNoDataTests.fs index 6ea555d1aac..1fb2ce2cc3f 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/CodeFixes/RemoveSuperfluousCaptureForUnionCaseWithNoDataTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/CodeFixes/RemoveSuperfluousCaptureForUnionCaseWithNoDataTests.fs @@ -10,18 +10,15 @@ open CodeFixTestFramework let private codeFix = RemoveSuperfluousCaptureForUnionCaseWithNoDataCodeFixProvider() -[] -[] -[] -[] -let ``Fixes FS3548 - DUs`` caseValue = +[] +let ``Fixes FS3548 - DUs`` () = let code = - $""" + """ type Type = | A | B of int let f x = match x with - | A {caseValue} -> 42 + | A _ -> 42 | B number -> number """ @@ -44,18 +41,40 @@ let f x = Assert.Equal(expected, actual) -[] -[] -[] -[] -let ``Fixes FS3548 - marker types`` caseValue = +[] +let ``Fixes FS3548 - discarded argument in function`` () = let code = - $""" + """ +type C = | C + +let myDiscardedArgFunc(C _) = () +""" + + let expected = + Some + { + Message = "Remove unused binding" + FixedCode = + """ +type C = | C + +let myDiscardedArgFunc(C) = () +""" + } + + let actual = codeFix |> tryFix code (WithOption "--langversion:preview") + + Assert.Equal(expected, actual) + +[] +let ``Fixes FS3548 - marker types`` () = + let code = + """ type Type = Type let f x = match x with - | Type {caseValue} -> () + | Type _ -> () """ let expected =