From 8432ff7d5aa3e46e95525a5fe19b78112020dc41 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Thu, 24 Aug 2023 16:05:15 +0200 Subject: [PATCH 1/2] Better error reporing for unions with duplicated fields --- src/Compiler/Checking/CheckDeclarations.fs | 27 +++++++++--- .../Types/UnionTypes/UnionTypes.fs | 43 ++++++++++++++++++- 2 files changed, 61 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 8f41152c420..4d4c19bd526 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -492,22 +492,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 attrs = TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs // the attributes of a union case decl get attached to the generated "static factory" method let vis, _ = ComputeAccessAndCompPath env None m vis None parent @@ -559,11 +557,26 @@ module TcRecdUnionAndEnumDeclarations = let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some names) 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 cenv env parent attrs thisTy caseRange (caseIdent: Ident) (xmldoc: PreXmlDoc) value = diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs index bc5f4e9d8c8..8b9e6467ba7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs @@ -272,7 +272,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 @@ -607,4 +607,43 @@ 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") ] - + + + [] + 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.") + ] + + [] + 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.") + ] + + [] + 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.") + ] \ No newline at end of file From 6938fc89029467f82e9a373bba6517e6ae98f991 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Thu, 24 Aug 2023 16:38:01 +0200 Subject: [PATCH 2/2] one more test --- .../Conformance/Types/UnionTypes/UnionTypes.fs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs index 8b9e6467ba7..94bfe921154 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Types/UnionTypes/UnionTypes.fs @@ -646,4 +646,22 @@ type X = |> 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.") + ] + + [] + 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.") ] \ No newline at end of file