Merge main to release/dev17.8

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))

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

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.")
-
-
+
 [<Fact>]
 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.")
     ]
 
+[<Fact>]
+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
+
 [<Fact>]
 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 =
     ]
 
 [<Fact>]
-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
-
-[<Fact>]
-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"""
+
+[<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_UnionCaseTakesNoArguments.fs"|])>]
+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")
     ]
-
-[<Fact>]
-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"""
+
+[<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_UnionCaseTakesNoArguments.fs"|])>]
+let ``Pattern named not allowed union case does not take any arguments with Lang preview`` compilation =
+    compilation
+    |> asFs
     |> withLangVersionPreview
+    |> 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")
     ]

vsintegration/tests/FSharp.Editor.Tests/CodeFixes/RemoveSuperfluousCaptureForUnionCaseWithNoDataTests.fs

@@ -10,18 +10,15 @@ open CodeFixTestFramework
 let private codeFix =
     RemoveSuperfluousCaptureForUnionCaseWithNoDataCodeFixProvider()
 
-[<Theory>]
-[<InlineData "_">]
-[<InlineData "__">]
-[<InlineData "a">]
-let ``Fixes FS3548 - DUs`` caseValue =
+[<Fact>]
+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)
 
-[<Theory>]
-[<InlineData "_">]
-[<InlineData "__">]
-[<InlineData "t">]
-let ``Fixes FS3548 - marker types`` caseValue =
+[<Fact>]
+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)
+
+[<Fact>]
+let ``Fixes FS3548 - marker types`` () =
+    let code =
+        """
 type Type = Type
 
 let f x =
     match x with
-    | Type {caseValue} -> ()
+    | Type _ -> ()
 """
 
     let expected =