Skip to content

Commit 5a5ca97

Browse files
auduchinokKevinRansom
authored andcommitted
Do not store union case compiled name (#6163)
* Do not store union case compiled name * Update test data to report only case name range
1 parent 99e307f commit 5a5ca97

File tree

5 files changed

+28
-27
lines changed

5 files changed

+28
-27
lines changed

src/fsharp/TastPickle.fs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2018,15 +2018,16 @@ and u_attribs_ext extraf st = u_list_ext extraf u_attrib st
20182018
and u_unioncase_spec st =
20192019
let a = u_rfield_table st
20202020
let b = u_ty st
2021-
let c = u_string st
2021+
2022+
// The union case compiled name is now computed from Id field when needed and is not stored in UnionCase record.
2023+
let _c = u_string st
20222024
let d = u_ident st
20232025
// The XmlDoc is only present in the extended in-memory format. We detect its presence using a marker bit here
20242026
let xmldoc, e = u_attribs_ext u_xmldoc st
20252027
let f = u_string st
20262028
let i = u_access st
20272029
{ FieldTable=a
20282030
ReturnType=b
2029-
CompiledName=c
20302031
Id=d
20312032
Attribs=e
20322033
XmlDoc= defaultArg xmldoc XmlDoc.Empty

src/fsharp/TypeChecker.fs

Lines changed: 15 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -12254,11 +12254,15 @@ module TcRecdUnionAndEnumDeclarations = begin
1225412254
// Bind other elements of type definitions (constructors etc.)
1225512255
//-------------------------------------------------------------------------
1225612256

12257-
let CheckUnionCaseName cenv realUnionCaseName m =
12258-
CheckNamespaceModuleOrTypeName cenv.g (mkSynId m realUnionCaseName)
12259-
if not (String.isUpper realUnionCaseName) && realUnionCaseName <> opNameCons && realUnionCaseName <> opNameNil then
12260-
errorR(NotUpperCaseConstructor(m))
12261-
12257+
let CheckUnionCaseName cenv (id: Ident) =
12258+
let name = id.idText
12259+
if name = "Tags" then
12260+
errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(name, "Tags"), id.idRange))
12261+
12262+
CheckNamespaceModuleOrTypeName cenv.g id
12263+
if not (String.isUpper name) && name <> opNameCons && name <> opNameNil then
12264+
errorR(NotUpperCaseConstructor(id.idRange))
12265+
1226212266
let ValidateFieldNames (synFields : SynField list, tastFields : RecdField list) =
1226312267
let seen = Dictionary()
1226412268
for (sf, f) in List.zip synFields tastFields do
@@ -12278,16 +12282,9 @@ module TcRecdUnionAndEnumDeclarations = begin
1227812282
let attrs = TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs // the attributes of a union case decl get attached to the generated "static factory" method
1227912283
let vis, _ = ComputeAccessAndCompPath env None m vis None parent
1228012284
let vis = CombineReprAccess parent vis
12281-
let realUnionCaseName =
12282-
if id.idText = opNameCons then "Cons"
12283-
elif id.idText = opNameNil then "Empty"
12284-
else id.idText
12285-
12286-
if realUnionCaseName = "Tags" then
12287-
errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(realUnionCaseName, "Tags"), m))
12288-
12289-
CheckUnionCaseName cenv realUnionCaseName id.idRange
12290-
12285+
12286+
CheckUnionCaseName cenv id
12287+
1229112288
let mkName nFields i = if nFields <= 1 then "Item" else "Item"+string (i+1)
1229212289
let rfields, recordTy =
1229312290
match args with
@@ -12311,7 +12308,7 @@ module TcRecdUnionAndEnumDeclarations = begin
1231112308
if not (typeEquiv cenv.g recordTy thisTy) then
1231212309
error(Error(FSComp.SR.tcReturnTypesForUnionMustBeSameAsType(), m))
1231312310
rfields, recordTy
12314-
NewUnionCase id realUnionCaseName rfields recordTy attrs (xmldoc.ToXmlDoc()) vis
12311+
NewUnionCase id rfields recordTy attrs (xmldoc.ToXmlDoc()) vis
1231512312

1231612313

1231712314
let TcUnionCaseDecls cenv env parent (thisTy : TType) tpenv unionCases =
@@ -15538,8 +15535,8 @@ module EstablishTypeDefinitionCores =
1553815535

1553915536
structLayoutAttributeCheck(false)
1554015537
noAllowNullLiteralAttributeCheck()
15541-
TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName.idText unionCaseName.idRange
15542-
let unionCase = NewUnionCase unionCaseName unionCaseName.idText [] thisTy [] XmlDoc.Empty tycon.Accessibility
15538+
TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName
15539+
let unionCase = NewUnionCase unionCaseName [] thisTy [] XmlDoc.Empty tycon.Accessibility
1554315540
writeFakeUnionCtorsToSink [ unionCase ]
1554415541
MakeUnionRepr [ unionCase ], None, NoSafeInitInfo
1554515542

src/fsharp/tast.fs

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1580,9 +1580,6 @@ and
15801580
/// Return type constructed by the case. Normally exactly the type of the enclosing type, sometimes an abbreviation of it
15811581
ReturnType: TType
15821582

1583-
/// Name of the case in generated IL code
1584-
CompiledName: string
1585-
15861583
/// Documentation for the case
15871584
XmlDoc : XmlDoc
15881585

@@ -1618,6 +1615,13 @@ and
16181615

16191616
member uc.DisplayName = uc.Id.idText
16201617

1618+
/// Name of the case in generated IL code.
1619+
member uc.CompiledName =
1620+
let idText = uc.Id.idText
1621+
if idText = opNameCons then "Cons"
1622+
elif idText = opNameNil then "Empty"
1623+
else idText
1624+
16211625
member uc.RecdFieldsArray = uc.FieldTable.FieldsByIndex
16221626

16231627
member uc.RecdFields = uc.FieldTable.FieldsByIndex |> Array.toList
@@ -5618,9 +5622,8 @@ let NewTypar (kind,rigid,Typar(id,staticReq,isCompGen),isFromError,dynamicReq,at
56185622

56195623
let NewRigidTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false)
56205624

5621-
let NewUnionCase id nm tys rty attribs docOption access : UnionCase =
5625+
let NewUnionCase id tys rty attribs docOption access : UnionCase =
56225626
{ Id=id
5623-
CompiledName=nm
56245627
XmlDoc=docOption
56255628
XmlDocSig=""
56265629
Accessibility=access

tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionFieldNamedTagNoDefault.fs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
// #Conformance #TypesAndModules #Unions
22
// RegressionTest for bug 6308
3-
//<Expects status="error" id="FS1219" span="(7,7-7,19)">The union case named 'Tags' conflicts with the generated type 'Tags'</Expects>
3+
//<Expects status="error" id="FS1219" span="(7,7-7,11)">The union case named 'Tags' conflicts with the generated type 'Tags'</Expects>
44
[<DefaultAugmentation(false)>]
55
type BigUnion2 =
66
| Case0

tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/E_UnionMemberNamedTag.fs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
// #Conformance #TypesAndModules #Unions
22
// RegressionTest for bug 6308
3-
//<Expects status="error" id="FS1219" span="(9,7-9,19)">The union case named 'Tags' conflicts with the generated type 'Tags'</Expects>
3+
//<Expects status="error" id="FS1219" span="(9,7-9,11)">The union case named 'Tags' conflicts with the generated type 'Tags'</Expects>
44
//<Expects status="notin" id="FS0023" span="(21,14-21,17)">The member 'Tag' can not be defined because the name 'Tag' clashes with the generated property 'Tag' in this type or module</Expects>
55

66
[<DefaultAugmentation(true)>]

0 commit comments

Comments
 (0)