diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index dccff65781..1e9c0418a1 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -565,7 +565,7 @@ and ApplyUnionCaseOrExn m (cenv: cenv) env overallTy item = UnifyTypes cenv env m overallTy g.exn_ty CheckTyconAccessible cenv.amap m ad ecref |> ignore let mkf mArgs args = TPat_exnconstr(ecref, args, unionRanges m mArgs) - mkf, recdFieldTysOfExnDefRef ecref, [ for f in (recdFieldsOfExnDefRef ecref) -> f.Id ] + mkf, recdFieldTysOfExnDefRef ecref, [ for f in (recdFieldsOfExnDefRef ecref) -> f ] | Item.UnionCase(ucinfo, showDeprecated) -> if showDeprecated then @@ -582,7 +582,7 @@ and ApplyUnionCaseOrExn m (cenv: cenv) env overallTy item = let inst = mkTyparInst ucref.TyconRef.TyparsNoRange ucinfo.TypeInst UnifyTypes cenv env m overallTy resTy let mkf mArgs args = TPat_unioncase(ucref, ucinfo.TypeInst, args, unionRanges m mArgs) - mkf, actualTysOfUnionCaseFields inst ucref, [ for f in ucref.AllFieldsAsList -> f.Id ] + mkf, actualTysOfUnionCaseFields inst ucref, [ for f in ucref.AllFieldsAsList -> f] | _ -> invalidArg "item" "not a union case or exception reference" @@ -610,7 +610,7 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m let extraPatterns = List () for id, _, pat in pairs do - match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with + match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.Id.idText) with | None -> extraPatterns.Add pat match item with @@ -678,7 +678,14 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m elif numArgs < numArgTys then if numArgTys > 1 then // Expects tuple without enough args - errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments numArgTys, m)) + let printTy = NicePrint.minimalStringOfType env.DisplayEnv + let missingArgs = + argNames.[numArgs..numArgTys - 1] + |> List.map (fun id -> (if id.rfield_name_generated then "" else id.DisplayName + ": ") + printTy id.FormalType) + |> String.concat (Environment.NewLine + "\t") + |> fun s -> Environment.NewLine + "\t" + s + + errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments(numArgTys, numArgs, missingArgs), m)) else errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, m)) args @ (List.init (numArgTys - numArgs) (fun _ -> SynPat.Wild (m.MakeSynthetic()))), extraPatterns diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 61054bba21..48b3905558 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -572,7 +572,7 @@ tcCouldNotFindIDisposable,"Couldn't find Dispose on IDisposable, or it was overl 724,tcInvalidIndexIntoActivePatternArray,"Internal error. Invalid index into active pattern array" 725,tcUnionCaseDoesNotTakeArguments,"This union case does not take arguments" 726,tcUnionCaseRequiresOneArgument,"This union case takes one argument" -727,tcUnionCaseExpectsTupledArguments,"This union case expects %d arguments in tupled form" +727,tcUnionCaseExpectsTupledArguments,"This union case expects %d arguments in tupled form, but was given %d. The missing field arguments may be any of:%s" 728,tcFieldIsNotStatic,"Field '%s' is not static" 729,tcFieldNotLiteralCannotBeUsedInPattern,"This field is not a literal and cannot be used in a pattern" 730,tcRequireVarConstRecogOrLiteral,"This is not a variable, constant, active recognizer or literal" diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index b3fcdd6c7d..dfdc9640a0 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4156,7 +4156,7 @@ type TType = (match anonInfo.TupInfo with | TupInfo.Const false -> "" | TupInfo.Const true -> "struct ") - + "{|" + String.concat "," (Seq.map2 (fun nm ty -> nm + " " + string ty + ";") anonInfo.SortedNames tinst) + ")" + "|}" + + "{|" + String.concat "," (Seq.map2 (fun nm ty -> nm + " " + string ty + ";") anonInfo.SortedNames tinst) + "|}" | TType_fun (domainTy, retTy, _) -> "(" + string domainTy + " -> " + string retTy + ")" | TType_ucase (uc, tinst) -> "ucase " + uc.CaseName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") | TType_var (tp, _) -> diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index e0e999dc99..04cb5e2725 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Tento případ typu union očekává argumenty v počtu {0} v podobě řazené kolekce členů. + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 9b090dcdb5..c7f65de13a 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Dieser Union-Fall erwartet {0} Argumente als Tupel. + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index a410c3381f..c76f988d7a 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Este caso de unión espera {0} argumentos en forma de tupla. + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 542a1f4fc3..a89ad51030 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Ce cas d'union attend {0} arguments basés sur des tuples + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 885462d431..a4044cee24 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Questo case di unione prevede {0} argomenti sotto forma di tupla + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index e75546a406..06c51c429d 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - この共用体ケースにはタプル形式の引数を {0} 個指定してください + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 0d61eacd4a..f6cfde3fd9 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - 이 공용 구조체 케이스에는 튜플된 형식의 인수 {0}개가 필요합니다. + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 32a58e4b23..95a8895c10 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Ten przypadek unii oczekuje {0} argumentów w postaci spójnej kolekcji + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 4146582741..f8e182c61d 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Este caso união espera argumentos {0} na forma de tupla + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 303abbe53e..6041cda9ec 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Для данного случая объединения требуется {0} аргументов в форме кортежа + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index d3e695d068..d9738db5a5 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - Bu birleşim durumu grup olarak tanımlanmış biçimde {0} bağımsız değişken bekliyor + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 29db57871b..0bf4e08015 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - 此联合用例需要 {0} 个元组格式的参数 + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 45bf1a5237..24faf41e95 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -3793,8 +3793,8 @@ - This union case expects {0} arguments in tupled form - 這個聯集需要 {0} 個 Tuple 形式的引數 + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} + This union case expects {0} arguments in tupled form, but was given {1}. The missing field arguments may be any of:{2} diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs new file mode 100644 index 0000000000..b64dff5176 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnionCasePatternMatchingErrors.fs @@ -0,0 +1,72 @@ +module FSharp.Compiler.ComponentTests.ErrorMessages.UnionCasePatternMatchingErrors + +open Xunit +open FSharp.Test.Compiler + +[] +let ``Union matching error - Incomplete union fields`` () = + FSharp """ +module Tests +type U = + | B of f1:int list * {|X:string|} * f3:U * f4: (int * System.String) + +let x : U = failwith "" +let myVal = + match x with + | B -> 42""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 727, Line 9, Col 7, Line 9, Col 8, + "This union case expects 4 arguments in tupled form, but was given 0. The missing field arguments may be any of: +\tf1: int list +\t{| X: string |} +\tf3: U +\tf4: (int * System.String)") + +[] +let ``Union matching error - Named args - Name used twice`` () = + FSharp """ +module Tests +type U = + | B of field: int * int +let x : U = failwith "" +let myVal = + match x with + | B (field = x; field = z) -> let y = x + z + 1 in ()""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 3175, Line 8, Col 21, Line 8, Col 26, "Union case/exception field 'field' cannot be used more than once.") + +[] +let ``Union matching error - Multiple tupled args`` () = + FSharp """ +module Tests +type U = + | B of field: int * int + +let x : U = failwith "" +let myVal = + match x with + | B x z -> let y = x + z + 1 in ()""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 727, Line 9, Col 7, Line 9, Col 12, "This union case expects 2 arguments in tupled form, but was given 0. The missing field arguments may be any of: +\tfield: int +\tint") + +[] +let ``Union matching error - Missing field`` () = + FSharp """ +module Tests +type U = + | A + | B of int * int * int + +let myVal = + match A with + | A -> 15 + | B (x, _) -> 16""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 727, Line 10, Col 7, Line 10, Col 15, "This union case expects 3 arguments in tupled form, but was given 2. The missing field arguments may be any of: +\tint") \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 4acda7d0cd..3ef7efa769 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -158,6 +158,7 @@ + diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index 8654a59caf..7daef75bcf 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -81,26 +81,6 @@ match 1, 2 with ] -[] -#if !NETCOREAPP -[] -#endif -let ``Union case 01 - Missing field`` () = - let _, checkResults = getParseAndCheckResults """ -type U = - | A - | B of int * int * int - -match A with -| B (x, _) -> let y = x + 1 in () -""" - assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ - "(7,2--7,10): This union case expects 3 arguments in tupled form" - "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." - ] - - [] #if !NETCOREAPP [] @@ -197,47 +177,6 @@ match A with "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] - -[] -#if !NETCOREAPP -[] -#endif -let ``Union case 07 - Named args - Name used twice`` () = - let _, checkResults = getParseAndCheckResults """ -type U = - | A - | B of field: int * int - -match A with -| B (field = x; field = z) -> let y = x + z + 1 in () -""" - assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ - "(7,16--7,21): Union case/exception field 'field' cannot be used more than once." - "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." - ] - - -[] -#if !NETCOREAPP -[] -#endif -let ``Union case 08 - Multiple tupled args`` () = - let _, checkResults = getParseAndCheckResults """ -type U = - | A - | B of field: int * int - -match A with -| B x z -> let y = x + z + 1 in () -""" - assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ - "(7,2--7,7): This union case expects 2 arguments in tupled form" - "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." - ] - - [] let ``Union case 09 - Single arg`` () = let _, checkResults = getParseAndCheckResults """ @@ -249,7 +188,6 @@ match None with dumpDiagnostics checkResults |> shouldEqual [ ] - [] #if !NETCOREAPP []