diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index 14998cc882d..e780768c29a 100755 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -2018,7 +2018,9 @@ and u_attribs_ext extraf st = u_list_ext extraf u_attrib st and u_unioncase_spec st = let a = u_rfield_table st let b = u_ty st - let c = u_string st + + // The union case compiled name is now computed from Id field when needed and is not stored in UnionCase record. + let _c = u_string st let d = u_ident st // The XmlDoc is only present in the extended in-memory format. We detect its presence using a marker bit here let xmldoc, e = u_attribs_ext u_xmldoc st @@ -2026,7 +2028,6 @@ and u_unioncase_spec st = let i = u_access st { FieldTable=a ReturnType=b - CompiledName=c Id=d Attribs=e XmlDoc= defaultArg xmldoc XmlDoc.Empty diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index a20b3743ca1..7a56b47ac50 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -12254,11 +12254,15 @@ module TcRecdUnionAndEnumDeclarations = begin // Bind other elements of type definitions (constructors etc.) //------------------------------------------------------------------------- - let CheckUnionCaseName cenv realUnionCaseName m = - CheckNamespaceModuleOrTypeName cenv.g (mkSynId m realUnionCaseName) - if not (String.isUpper realUnionCaseName) && realUnionCaseName <> opNameCons && realUnionCaseName <> opNameNil then - errorR(NotUpperCaseConstructor(m)) - + let CheckUnionCaseName cenv (id: Ident) = + let name = id.idText + if name = "Tags" then + errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(name, "Tags"), id.idRange)) + + CheckNamespaceModuleOrTypeName cenv.g id + if not (String.isUpper name) && name <> opNameCons && name <> opNameNil then + errorR(NotUpperCaseConstructor(id.idRange)) + let ValidateFieldNames (synFields : SynField list, tastFields : RecdField list) = let seen = Dictionary() for (sf, f) in List.zip synFields tastFields do @@ -12278,16 +12282,9 @@ module TcRecdUnionAndEnumDeclarations = begin 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 let vis = CombineReprAccess parent vis - let realUnionCaseName = - if id.idText = opNameCons then "Cons" - elif id.idText = opNameNil then "Empty" - else id.idText - - if realUnionCaseName = "Tags" then - errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(realUnionCaseName, "Tags"), m)) - - CheckUnionCaseName cenv realUnionCaseName id.idRange - + + CheckUnionCaseName cenv id + let mkName nFields i = if nFields <= 1 then "Item" else "Item"+string (i+1) let rfields, recordTy = match args with @@ -12311,7 +12308,7 @@ module TcRecdUnionAndEnumDeclarations = begin if not (typeEquiv cenv.g recordTy thisTy) then error(Error(FSComp.SR.tcReturnTypesForUnionMustBeSameAsType(), m)) rfields, recordTy - NewUnionCase id realUnionCaseName rfields recordTy attrs (xmldoc.ToXmlDoc()) vis + NewUnionCase id rfields recordTy attrs (xmldoc.ToXmlDoc()) vis let TcUnionCaseDecls cenv env parent (thisTy : TType) tpenv unionCases = @@ -15538,8 +15535,8 @@ module EstablishTypeDefinitionCores = structLayoutAttributeCheck(false) noAllowNullLiteralAttributeCheck() - TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName.idText unionCaseName.idRange - let unionCase = NewUnionCase unionCaseName unionCaseName.idText [] thisTy [] XmlDoc.Empty tycon.Accessibility + TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName + let unionCase = NewUnionCase unionCaseName [] thisTy [] XmlDoc.Empty tycon.Accessibility writeFakeUnionCtorsToSink [ unionCase ] MakeUnionRepr [ unionCase ], None, NoSafeInitInfo diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 63e7412d902..4d645fa2541 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -1580,9 +1580,6 @@ and /// Return type constructed by the case. Normally exactly the type of the enclosing type, sometimes an abbreviation of it ReturnType: TType - /// Name of the case in generated IL code - CompiledName: string - /// Documentation for the case XmlDoc : XmlDoc @@ -1618,6 +1615,13 @@ and member uc.DisplayName = uc.Id.idText + /// Name of the case in generated IL code. + member uc.CompiledName = + let idText = uc.Id.idText + if idText = opNameCons then "Cons" + elif idText = opNameNil then "Empty" + else idText + member uc.RecdFieldsArray = uc.FieldTable.FieldsByIndex member uc.RecdFields = uc.FieldTable.FieldsByIndex |> Array.toList @@ -5618,9 +5622,8 @@ let NewTypar (kind,rigid,Typar(id,staticReq,isCompGen),isFromError,dynamicReq,at let NewRigidTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false) -let NewUnionCase id nm tys rty attribs docOption access : UnionCase = +let NewUnionCase id tys rty attribs docOption access : UnionCase = { Id=id - CompiledName=nm XmlDoc=docOption XmlDocSig="" Accessibility=access diff --git a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionFieldNamedTagNoDefault.fs b/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionFieldNamedTagNoDefault.fs index 6fa9628ef67..4cc6816ef3a 100644 --- a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionFieldNamedTagNoDefault.fs +++ b/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionFieldNamedTagNoDefault.fs @@ -1,6 +1,6 @@ // #Conformance #TypesAndModules #Unions // RegressionTest for bug 6308 -//The union case named 'Tags' conflicts with the generated type 'Tags' +//The union case named 'Tags' conflicts with the generated type 'Tags' [] type BigUnion2 = | Case0 diff --git a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionMemberNamedTag.fs b/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionMemberNamedTag.fs index cdc4f08e0f5..c24b28593ae 100644 --- a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionMemberNamedTag.fs +++ b/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionMemberNamedTag.fs @@ -1,6 +1,6 @@ // #Conformance #TypesAndModules #Unions // RegressionTest for bug 6308 -//The union case named 'Tags' conflicts with the generated type 'Tags' +//The union case named 'Tags' conflicts with the generated type 'Tags' //The member 'Tag' can not be defined because the name 'Tag' clashes with the generated property 'Tag' in this type or module []