Skip to content

Commit 0f30853

Browse files
edgarfgpedgarfgp
authored
Fix regression for FS0725 (#15874)
1 parent 6d1efc6 commit 0f30853

File tree

4 files changed

+194
-51
lines changed

4 files changed

+194
-51
lines changed

‎src/Compiler/Checking/CheckPatterns.fs

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -595,18 +595,23 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
595595

596596
let mkf, argTys, argNames = ApplyUnionCaseOrExn m cenv env ty item
597597
let numArgTys = argTys.Length
598+
let warnOnUnionWithNoData =
599+
g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData)
598600

599601
let args, extraPatternsFromNames =
600602
match args with
601603
| SynArgPats.Pats args ->
602-
if g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) then
604+
if warnOnUnionWithNoData then
603605
match args with
604-
| [ SynPat.Wild _ ] | [ SynPat.Named _ ] when argNames.IsEmpty ->
606+
| [ SynPat.Wild _ ] when argNames.IsEmpty ->
607+
// Here we only care about the cases where the user has written the wildcard pattern explicitly
608+
// | Case _ -> ...
609+
// let myDiscardedArgFunc(Case _) = ..."""
610+
// 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.
611+
// The rest of the cases will still be reported as FS0725
605612
warning(Error(FSComp.SR.matchNotAllowedForUnionCaseWithNoData(), m))
606-
args, []
607-
| _ -> args, []
608-
else
609-
args, []
613+
| _ -> ()
614+
args, []
610615
| SynArgPats.NamePatPairs (pairs, m, _) ->
611616
// rewrite patterns from the form (name-N = pat-N; ...) to (..._, pat-N, _...)
612617
// so type T = Case of name: int * value: int
@@ -664,12 +669,8 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
664669
| [SynPatErrorSkip(SynPat.Wild _ as e) | SynPatErrorSkip(SynPat.Paren(SynPatErrorSkip(SynPat.Wild _ as e), _))] -> List.replicate numArgTys e, []
665670

666671
| args when numArgTys = 0 ->
667-
if g.langVersion.SupportsFeature(LanguageFeature.MatchNotAllowedForUnionCaseWithNoData) then
668-
[], args
669-
else
670-
errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m))
671-
[], args
672-
672+
errorR (Error (FSComp.SR.tcUnionCaseDoesNotTakeArguments (), m))
673+
[], args
673674
| arg :: rest when numArgTys = 1 ->
674675
if numArgTys = 1 && not (List.isEmpty rest) then
675676
errorR (Error (FSComp.SR.tcUnionCaseRequiresOneArgument (), m))

‎tests/FSharp.Compiler.ComponentTests/ErrorMessages/E_UnionCaseTakesNoArguments.fs

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
type A = { X: int }
2+
3+
type B = | B of int
4+
5+
type C = | C
6+
7+
match None with
8+
| None 1 -> ()
9+
10+
match None with
11+
| None (1, 2) -> ()
12+
13+
match None with
14+
| None [] -> ()
15+
16+
match None with
17+
| None [||] -> ()
18+
19+
match None with
20+
| None { X = 1 } -> ()
21+
22+
match None with
23+
| None (B 1) -> ()
24+
25+
match None with
26+
| None (x, y) -> ()
27+
28+
match None with
29+
| None false -> ()
30+
31+
match None with
32+
| None _ -> () // Wildcard pattern raises a warning in F# 8.0
33+
34+
match None with
35+
| None x -> ()
36+
37+
match None with
38+
| None (x, y) -> ()
39+
| Some _ -> ()
40+
41+
match None with
42+
| None x y -> ()
43+
| Some _ -> ()
44+
45+
let c = C
46+
47+
match c with
48+
| C _ _ -> ()
49+
50+
match c with
51+
| C __ -> ()
52+
53+
let myDiscardedArgFunc(C _) = () // Wildcard pattern raises a warning in F# 8.0
54+
55+
let myDiscardedArgFunc2(C c) = ()
56+
57+
let myDiscardedArgFunc3(C __) = 5+5
58+
59+
let myDiscardedArgFunc(None x y) = None

‎tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs

Lines changed: 89 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
module ErrorMessages.UnionCasePatternMatchingErrors
22

3+
open FSharp.Test
34
open Xunit
45
open FSharp.Test.Compiler
56

@@ -86,8 +87,7 @@ let myVal =
8687
|> typecheck
8788
|> shouldFail
8889
|> withSingleDiagnostic (Warning 3548, Line 9, Col 7, Line 9, Col 10, "Pattern discard is not allowed for union case that takes no data.")
89-
90-
90+
9191
[<Fact>]
9292
let ``Union Pattern discard allowed for union case that takes no data with Lang version 7`` () =
9393
FSharp """
@@ -245,6 +245,30 @@ let myVal =
245245
(Warning 3548, Line 17, Col 20, Line 17, Col 23, "Pattern discard is not allowed for union case that takes no data.")
246246
]
247247

248+
[<Fact>]
249+
let ``Multiple pattern discards not allowed for union case that takes no data with Lang 7`` () =
250+
FSharp """
251+
module Tests
252+
type U =
253+
| A
254+
| B of int * int * int
255+
| C of int * int * int
256+
257+
type V =
258+
| D
259+
260+
let a : U = A
261+
let d : V = D
262+
263+
let myVal =
264+
match a, d with
265+
| A _, D -> 15
266+
| B (x, _, _), D _ -> 16
267+
| C _, _ -> 17"""
268+
|> withLangVersion70
269+
|> typecheck
270+
|> shouldSucceed
271+
248272
[<Fact>]
249273
let ``Multiple function pattern discards is not allowed for union case that takes no data with Lang preview`` () =
250274
FSharp """
@@ -274,42 +298,82 @@ let myVal =
274298
]
275299

276300
[<Fact>]
277-
let ``Pattern discard allowed for single-case unions when using them as a deconstruct syntax in functions with Lang 7`` () =
301+
let ``Multiple function pattern discards is not allowed for union case that takes no data with Lang 7`` () =
278302
FSharp """
279303
module Tests
280-
type MyWrapper = A
304+
type U =
305+
| A
306+
| B of int * int * int
307+
| C of int * int * int
308+
309+
type V =
310+
| D
311+
312+
let a : U = A
281313
282-
let myDiscardedArgFunc(A _) = 5+5"""
314+
let d : V = D
315+
316+
let myVal =
317+
function
318+
| A _, D -> 15
319+
| B (x, _, _), D _ -> 16
320+
| C _, _ -> 17"""
283321
|> withLangVersion70
284322
|> typecheck
285323
|> shouldSucceed
286-
287-
[<Fact>]
288-
let ``Pattern named not allowed for single-case unions when using them as a deconstruct syntax in functions with Lang 7`` () =
289-
FSharp """
290-
module Tests
291-
type MyWrapper = A
292-
293-
let myFunc(A a) = 5+5"""
324+
325+
[<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_UnionCaseTakesNoArguments.fs"|])>]
326+
let ``Pattern named not allowed union case does not take any arguments with Lang 7`` compilation =
327+
compilation
328+
|> asFs
294329
|> withLangVersion70
330+
|> withOptions ["--nowarn:25"]
295331
|> typecheck
296332
|> shouldFail
297333
|> withDiagnostics [
298-
(Error 725, Line 5, Col 12, Line 5, Col 15, "This union case does not take arguments")
334+
(Error 725, Line 8, Col 3, Line 8, Col 9, "This union case does not take arguments");
335+
(Error 725, Line 11, Col 3, Line 11, Col 14, "This union case does not take arguments")
336+
(Error 725, Line 14, Col 3, Line 14, Col 10, "This union case does not take arguments")
337+
(Error 725, Line 17, Col 3, Line 17, Col 12, "This union case does not take arguments")
338+
(Error 725, Line 20, Col 3, Line 20, Col 17, "This union case does not take arguments")
339+
(Error 725, Line 23, Col 3, Line 23, Col 13, "This union case does not take arguments")
340+
(Error 725, Line 26, Col 3, Line 26, Col 14, "This union case does not take arguments")
341+
(Error 725, Line 29, Col 3, Line 29, Col 13, "This union case does not take arguments")
342+
(Error 725, Line 35, Col 3, Line 35, Col 9, "This union case does not take arguments")
343+
(Error 725, Line 38, Col 3, Line 38, Col 14, "This union case does not take arguments")
344+
(Error 725, Line 42, Col 3, Line 42, Col 11, "This union case does not take arguments")
345+
(Error 725, Line 48, Col 3, Line 48, Col 8, "This union case does not take arguments")
346+
(Error 725, Line 51, Col 3, Line 51, Col 7, "This union case does not take arguments")
347+
(Error 725, Line 55, Col 25, Line 55, Col 28, "This union case does not take arguments")
348+
(Error 725, Line 57, Col 25, Line 57, Col 29, "This union case does not take arguments")
349+
(Error 725, Line 59, Col 24, Line 59, Col 32, "This union case does not take arguments")
299350
]
300-
301-
[<Fact>]
302-
let ``Pattern discard or named are not allowed for single-case union case that takes no data with Lang preview`` () =
303-
FSharp """
304-
module Tests
305-
type MyWrapper = A
306-
307-
let myFunc(A a) = 5+5
308-
let myDiscardedArgFunc(A _) = 5+5"""
351+
352+
[<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"E_UnionCaseTakesNoArguments.fs"|])>]
353+
let ``Pattern named not allowed union case does not take any arguments with Lang preview`` compilation =
354+
compilation
355+
|> asFs
309356
|> withLangVersionPreview
357+
|> withOptions ["--nowarn:25"]
310358
|> typecheck
311359
|> shouldFail
312360
|> withDiagnostics [
313-
(Warning 3548, Line 5, Col 12, Line 5, Col 15, "Pattern discard is not allowed for union case that takes no data.")
314-
(Warning 3548, Line 6, Col 24, Line 6, Col 27, "Pattern discard is not allowed for union case that takes no data.")
361+
(Error 725, Line 8, Col 3, Line 8, Col 9, "This union case does not take arguments")
362+
(Error 725, Line 11, Col 3, Line 11, Col 14, "This union case does not take arguments")
363+
(Error 725, Line 14, Col 3, Line 14, Col 10, "This union case does not take arguments")
364+
(Error 725, Line 17, Col 3, Line 17, Col 12, "This union case does not take arguments")
365+
(Error 725, Line 20, Col 3, Line 20, Col 17, "This union case does not take arguments")
366+
(Error 725, Line 23, Col 3, Line 23, Col 13, "This union case does not take arguments")
367+
(Error 725, Line 26, Col 3, Line 26, Col 14, "This union case does not take arguments")
368+
(Error 725, Line 29, Col 3, Line 29, Col 13, "This union case does not take arguments")
369+
(Warning 3548, Line 32, Col 3, Line 32, Col 9, "Pattern discard is not allowed for union case that takes no data.")
370+
(Error 725, Line 35, Col 3, Line 35, Col 9, "This union case does not take arguments")
371+
(Error 725, Line 38, Col 3, Line 38, Col 14, "This union case does not take arguments")
372+
(Error 725, Line 42, Col 3, Line 42, Col 11, "This union case does not take arguments")
373+
(Error 725, Line 48, Col 3, Line 48, Col 8, "This union case does not take arguments")
374+
(Error 725, Line 51, Col 3, Line 51, Col 7, "This union case does not take arguments")
375+
(Warning 3548, Line 53, Col 24, Line 53, Col 27, "Pattern discard is not allowed for union case that takes no data.")
376+
(Error 725, Line 55, Col 25, Line 55, Col 28, "This union case does not take arguments")
377+
(Error 725, Line 57, Col 25, Line 57, Col 29, "This union case does not take arguments")
378+
(Error 725, Line 59, Col 24, Line 59, Col 32, "This union case does not take arguments")
315379
]

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

Lines changed: 33 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -10,18 +10,15 @@ open CodeFixTestFramework
1010
let private codeFix =
1111
RemoveSuperfluousCaptureForUnionCaseWithNoDataCodeFixProvider()
1212

13-
[<Theory>]
14-
[<InlineData "_">]
15-
[<InlineData "__">]
16-
[<InlineData "a">]
17-
let ``Fixes FS3548 - DUs`` caseValue =
13+
[<Fact>]
14+
let ``Fixes FS3548 - DUs`` () =
1815
let code =
19-
$"""
16+
"""
2017
type Type = | A | B of int
2118
2219
let f x =
2320
match x with
24-
| A {caseValue} -> 42
21+
| A _ -> 42
2522
| B number -> number
2623
"""
2724

@@ -44,18 +41,40 @@ let f x =
4441

4542
Assert.Equal(expected, actual)
4643

47-
[<Theory>]
48-
[<InlineData "_">]
49-
[<InlineData "__">]
50-
[<InlineData "t">]
51-
let ``Fixes FS3548 - marker types`` caseValue =
44+
[<Fact>]
45+
let ``Fixes FS3548 - discarded argument in function`` () =
5246
let code =
53-
$"""
47+
"""
48+
type C = | C
49+
50+
let myDiscardedArgFunc(C _) = ()
51+
"""
52+
53+
let expected =
54+
Some
55+
{
56+
Message = "Remove unused binding"
57+
FixedCode =
58+
"""
59+
type C = | C
60+
61+
let myDiscardedArgFunc(C) = ()
62+
"""
63+
}
64+
65+
let actual = codeFix |> tryFix code (WithOption "--langversion:preview")
66+
67+
Assert.Equal(expected, actual)
68+
69+
[<Fact>]
70+
let ``Fixes FS3548 - marker types`` () =
71+
let code =
72+
"""
5473
type Type = Type
5574
5675
let f x =
5776
match x with
58-
| Type {caseValue} -> ()
77+
| Type _ -> ()
5978
"""
6079

6180
let expected =

0 commit comments

Comments
 (0)