diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 0cb1515cbf..6f94be6fce 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -5535,7 +5535,6 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p 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)) @@ -5544,23 +5543,24 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p | [arg] -> [arg], [] | args -> - errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments numArgTys, m)) [], args let args, extraPatterns = let numArgs = args.Length if numArgs = numArgTys then args, extraPatterns + elif numArgs < numArgTys then + if numArgTys > 1 then + // Expects tuple without enough args + errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments numArgTys, m)) + else + errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, m)) + args @ (List.init (numArgTys - numArgs) (fun _ -> SynPat.Wild (m.MakeSynthetic()))), extraPatterns else - if numArgs < numArgTys then - if numArgs <> 0 && numArgTys <> 0 then - errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, m)) - args @ (List.init (numArgTys - numArgs) (fun _ -> SynPat.Wild (m.MakeSynthetic()))), extraPatterns - else - let args, remaining = args |> List.splitAt numArgTys - for remainingArg in remaining do - errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, remainingArg.Range)) - args, extraPatterns @ remaining + let args, remaining = args |> List.splitAt numArgTys + for remainingArg in remaining do + errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, remainingArg.Range)) + args, extraPatterns @ remaining let extraPatterns = extraPatterns @ extraPatternsFromNames let args', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) argTys args diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index 60f6327d3c..b426147393 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -80,7 +80,7 @@ match A with """ assertHasSymbolUsages ["x"; "y"] checkResults dumpErrors checkResults |> shouldEqual [ - "(7,2--7,10): This constructor is applied to 2 argument(s) but expects 3" + "(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)." ] @@ -257,6 +257,23 @@ match TraceLevel.Off with ] +[] +let ``Caseless DU`` () = + let _, checkResults = getParseAndCheckResults """ +type DU = Case of int + +let f du = + match du with + | Case -> () + +let dowork () = + f (Case 1) + 0 // return an integer exit code""" + assertHasSymbolUsages ["DU"; "dowork"; "du"; "f"] checkResults + dumpErrors checkResults |> shouldEqual [ + "(6,6--6,10): This constructor is applied to 0 argument(s) but expects 1" + ] + [] let ``Or 01 - No errors`` () = let _, checkResults = getParseAndCheckResults """