Better error reporting for unions with duplicated fields

src/Compiler/Checking/CheckDeclarations.fs

@@ -500,22 +500,20 @@ module TcRecdUnionAndEnumDeclarations =
             if not (String.isLeadingIdentifierCharacterUpperCase name) && name <> opNameCons && name <> opNameNil then
                 errorR(NotUpperCaseConstructor(id.idRange))
 
-    let ValidateFieldNames (synFields: SynField list, tastFields: RecdField list) = 
+    let ValidateFieldNames (synFields: SynField list, tastFields: RecdField list) =
         let seen = Dictionary()
         (synFields, tastFields) ||> List.iter2 (fun sf f ->
             match seen.TryGetValue f.LogicalName with
             | true, synField ->
                 match sf, synField with
-                | SynField(idOpt = Some id), SynField(idOpt = Some _) ->
-                    error(Error(FSComp.SR.tcFieldNameIsUsedModeThanOnce(id.idText), id.idRange))
                 | SynField(idOpt = Some id), SynField(idOpt = None)
                 | SynField(idOpt = None), SynField(idOpt = Some id) ->
                     error(Error(FSComp.SR.tcFieldNameConflictsWithGeneratedNameForAnonymousField(id.idText), id.idRange))
-                | _ -> assert false
+                | _ -> ()
             | _ ->
                 seen.Add(f.LogicalName, sf))
 
-    let TcUnionCaseDecl (cenv: cenv) env parent thisTy thisTyInst tpenv hasRQAAttribute (SynUnionCase(Attributes synAttrs, SynIdent(id, _), args, xmldoc, vis, m, _)) =
+    let TcUnionCaseDecl (cenv: cenv) env parent thisTy thisTyInst tpenv hasRQAAttribute (SynUnionCase(Attributes synAttrs, SynIdent(ident= id), args, xmldoc, vis, m, _)) =
         let g = cenv.g
         let vis, _ = ComputeAccessAndCompPath g env None m vis None parent
         let vis = CombineReprAccess parent vis
@@ -588,11 +586,26 @@ module TcRecdUnionAndEnumDeclarations =
 
         Construct.NewUnionCase id rfields recordTy attrs xmlDoc vis
 
+    let CheckUnionDuplicateFields (elems: Ident list) =
+        elems |> List.iteri (fun i (uc1: Ident) -> 
+            elems |> List.iteri (fun j (uc2: Ident) -> 
+                if j > i && uc1.idText = uc2.idText then 
+                   errorR(Error(FSComp.SR.tcFieldNameIsUsedModeThanOnce(uc1.idText), uc1.idRange))))
+
     let TcUnionCaseDecls (cenv: cenv) env (parent: ParentRef) (thisTy: TType) (thisTyInst: TypeInst) hasRQAAttribute tpenv unionCases =
         let unionCasesR =
             unionCases
-            |> List.filter (fun (SynUnionCase(_, SynIdent(id, _), _, _, _, _, _)) -> id.idText <> "")
-            |> List.map (TcUnionCaseDecl cenv env parent thisTy thisTyInst tpenv hasRQAAttribute) 
+            |> List.choose(fun syn ->
+                match syn with
+                | SynUnionCase(ident= SynIdent(ident = id)) as syn when id.idText <> ""  ->
+                    Some (TcUnionCaseDecl cenv env parent thisTy thisTyInst tpenv hasRQAAttribute syn)
+                | _ -> None)
+
+        for uc in unionCasesR do
+            let fields = uc.FieldTable.TrueInstanceFieldsAsList |> List.map (fun f -> f.Id)
+            if fields.Length > 1 then
+                CheckUnionDuplicateFields fields
+
         unionCasesR |> CheckDuplicates (fun uc -> uc.Id) "union case" 
 
     let MakeEnumCaseSpec g cenv env parent attrs thisTy caseRange (caseIdent: Ident) (xmldoc: PreXmlDoc) value =

tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs

@@ -273,7 +273,7 @@ module UnionTypes =
         |> shouldFail
         |> withDiagnostics [
             (Error 3176, Line 7, Col 16, Line 7, Col 21, "Named field 'Item2' conflicts with autogenerated name for anonymous field.")
-            (Error 3176, Line 10, Col 26, Line 10, Col 27, "Named field 'A' is used more than once.")
+            (Error 3176, Line 10, Col 16, Line 10, Col 17, "Named field 'A' is used more than once.")
         ]
 
     //SOURCE=E_UnionFieldNamedTag.fs SCFLAGS="--test:ErrorRanges"                                 # E_UnionFieldNamedTag.fs
@@ -610,6 +610,64 @@ module UnionTypes =
         |> withDiagnostics [
             (Warning 42, Line 11, Col 12, Line 11, Col 24, "This construct is deprecated: it is only for use in the F# library")
         ]
+
+
+    [<Fact>]
+    let ``Union field appears multiple times in union declaration`` () =
+        Fsx """
+type X =
+    | A of a: int * a: int
+        """
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 3176, Line 3, Col 12, Line 3, Col 13, "Named field 'a' is used more than once.")
+        ]
+
+    [<Fact>]
+    let ``Union field appears multiple times in union declaration 2`` () =
+        Fsx """
+type X =
+    | A of a: int * a: int
+    | B of a: int * a: int
+        """
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 3176, Line 3, Col 12, Line 3, Col 13, "Named field 'a' is used more than once.")
+            (Error 3176, Line 4, Col 12, Line 4, Col 13, "Named field 'a' is used more than once.")
+        ]
+
+    [<Fact>]
+    let ``Union field appears multiple times in union declaration 3`` () =
+        Fsx """
+type X =
+    | A of a: int * a: int * a: int
+        """
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 3176, Line 3, Col 12, Line 3, Col 13, "Named field 'a' is used more than once.")
+            (Error 3176, Line 3, Col 21, Line 3, Col 22, "Named field 'a' is used more than once.")
+        ]
+
+    [<Fact>]
+    let ``Union field appears multiple times in union declaration 4`` () =
+        Fsx """
+type X =
+    | A of a: int * a: int
+
+let x = A (1, 2)
+
+match x with
+| A(a = 1) -> ()
+| _ -> ()
+        """
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 3176, Line 3, Col 12, Line 3, Col 13, "Named field 'a' is used more than once.")
+        ]
 
     [<Theory>]
     [<InlineData(false)>]