Skip to content

Commit 463ce71

Browse files
keramsT-Gro
kerams
and
T-Gro
authored
Allow arithmetic in enum definitions (#14464)
* Allow arithmetic in enum definitions * Fix enum case checking * Refactor * Fix up error ranges, address comments * Fix fsharpqa tests * Fix merge conflicts Co-authored-by: Tomas Grosup <[email protected]>
1 parent b5a99ab commit 463ce71

File tree

14 files changed

+112
-52
lines changed

14 files changed

+112
-52
lines changed

‎src/Compiler/Checking/CheckDeclarations.fs‎

Lines changed: 31 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -561,26 +561,38 @@ module TcRecdUnionAndEnumDeclarations =
561561
let unionCasesR = unionCases |> List.map (TcUnionCaseDecl cenv env parent thisTy thisTyInst tpenv hasRQAAttribute)
562562
unionCasesR |> CheckDuplicates (fun uc -> uc.Id) "union case"
563563

564-
let TcEnumDecl cenv env parent thisTy fieldTy (SynEnumCase(attributes=Attributes synAttrs; ident= SynIdent(id,_); value=v; xmlDoc=xmldoc; range=m)) =
564+
let MakeEnumCaseSpec cenv env parent attrs thisTy caseRange (caseIdent: Ident) (xmldoc: PreXmlDoc) value =
565+
let vis, _ = ComputeAccessAndCompPath env None caseRange None None parent
566+
let vis = CombineReprAccess parent vis
567+
if caseIdent.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(), caseIdent.idRange))
568+
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
569+
let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some [])
570+
Construct.NewRecdField true (Some value) caseIdent false thisTy false false [] attrs xmlDoc vis false
571+
572+
let TcEnumDecl cenv env tpenv parent thisTy fieldTy (SynEnumCase (attributes = Attributes synAttrs; ident = SynIdent (id, _); valueExpr = valueExpr; xmlDoc = xmldoc; range = caseRange)) =
565573
let attrs = TcAttributes cenv env AttributeTargets.Field synAttrs
566-
567-
match v with
568-
| SynConst.Bytes _
569-
| SynConst.UInt16s _
570-
| SynConst.UserNum _ -> error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), m))
571-
| _ ->
572-
let v = TcConst cenv fieldTy m env v
573-
let vis, _ = ComputeAccessAndCompPath env None m None None parent
574-
let vis = CombineReprAccess parent vis
575-
if id.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(), id.idRange))
576-
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
577-
let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some [])
578-
Construct.NewRecdField true (Some v) id false thisTy false false [] attrs xmlDoc vis false
579-
580-
let TcEnumDecls (cenv: cenv) env parent thisTy enumCases =
574+
let valueRange = valueExpr.Range
575+
576+
match valueExpr with
577+
| SynExpr.Const (constant = SynConst.Bytes _ | SynConst.UInt16s _ | SynConst.UserNum _) ->
578+
error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), valueRange))
579+
| SynExpr.Const (synConst, _) ->
580+
let konst = TcConst cenv fieldTy valueRange env synConst
581+
MakeEnumCaseSpec cenv env parent attrs thisTy caseRange id xmldoc konst
582+
| _ when cenv.g.langVersion.SupportsFeature LanguageFeature.ArithmeticInLiterals ->
583+
let expr, actualTy, _ = TcExprOfUnknownType cenv env tpenv valueExpr
584+
UnifyTypes cenv env valueRange fieldTy actualTy
585+
586+
match EvalLiteralExprOrAttribArg cenv.g expr with
587+
| Expr.Const (konst, _, _) -> MakeEnumCaseSpec cenv env parent attrs thisTy caseRange id xmldoc konst
588+
| _ -> error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), valueRange))
589+
| _ ->
590+
error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), valueRange))
591+
592+
let TcEnumDecls (cenv: cenv) env tpenv parent thisTy enumCases =
581593
let g = cenv.g
582594
let fieldTy = NewInferenceType g
583-
let enumCases' = enumCases |> List.map (TcEnumDecl cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element"
595+
let enumCases' = enumCases |> List.map (TcEnumDecl cenv env tpenv parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element"
584596
fieldTy, enumCases'
585597

586598
//-------------------------------------------------------------------------
@@ -3483,7 +3495,7 @@ module EstablishTypeDefinitionCores =
34833495
repr, baseValOpt, safeInitInfo
34843496

34853497
| SynTypeDefnSimpleRepr.Enum (decls, m) ->
3486-
let fieldTy, fields' = TcRecdUnionAndEnumDeclarations.TcEnumDecls cenv envinner innerParent thisTy decls
3498+
let fieldTy, fields' = TcRecdUnionAndEnumDeclarations.TcEnumDecls cenv envinner tpenv innerParent thisTy decls
34873499
let kind = TFSharpEnum
34883500
structLayoutAttributeCheck false
34893501
noCLIMutableAttributeCheck()
@@ -3492,7 +3504,7 @@ module EstablishTypeDefinitionCores =
34923504
let vid = ident("value__", m)
34933505
let vfld = Construct.NewRecdField false None vid false fieldTy false false [] [] XmlDoc.Empty taccessPublic true
34943506

3495-
let legitEnumTypes = [ g.int32_ty; g.int16_ty; g.sbyte_ty; g.int64_ty; g.char_ty; g.bool_ty; g.uint32_ty; g.uint16_ty; g.byte_ty; g.uint64_ty ]
3507+
let legitEnumTypes = [ g.int32_ty; g.int16_ty; g.sbyte_ty; g.int64_ty; g.char_ty; g.uint32_ty; g.uint16_ty; g.byte_ty; g.uint64_ty ]
34963508
if not (ListSet.contains (typeEquiv g) fieldTy legitEnumTypes) then
34973509
errorR(Error(FSComp.SR.tcInvalidTypeForLiteralEnumeration(), m))
34983510

‎src/Compiler/SyntaxTree/SyntaxTree.fs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1197,8 +1197,7 @@ type SynEnumCase =
11971197
| SynEnumCase of
11981198
attributes: SynAttributes *
11991199
ident: SynIdent *
1200-
value: SynConst *
1201-
valueRange: range *
1200+
valueExpr: SynExpr *
12021201
xmlDoc: PreXmlDoc *
12031202
range: range *
12041203
trivia: SynEnumCaseTrivia

‎src/Compiler/SyntaxTree/SyntaxTree.fsi‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1349,8 +1349,7 @@ type SynEnumCase =
13491349
| SynEnumCase of
13501350
attributes: SynAttributes *
13511351
ident: SynIdent *
1352-
value: SynConst *
1353-
valueRange: range *
1352+
valueExpr: SynExpr *
13541353
xmlDoc: PreXmlDoc *
13551354
range: range *
13561355
trivia: SynEnumCaseTrivia

‎src/Compiler/pars.fsy‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2381,14 +2381,14 @@ attrUnionCaseDecl:
23812381
let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
23822382
Choice2Of2 (SynUnionCase ( $1, $3, SynUnionCaseKind.FullType $5, xmlDoc, None, mDecl, trivia))) }
23832383

2384-
| opt_attributes opt_access unionCaseName EQUALS constant
2384+
| opt_attributes opt_access unionCaseName EQUALS atomicExpr
23852385
{ if Option.isSome $2 then errorR(Error(FSComp.SR.parsEnumFieldsCannotHaveVisibilityDeclarations(), rhs parseState 2))
23862386
let mEquals = rhs parseState 4
23872387
let mDecl = rhs2 parseState 1 5
23882388
(fun (xmlDoc, mBar) ->
23892389
let trivia: SynEnumCaseTrivia = { BarRange = Some mBar; EqualsRange = mEquals }
23902390
let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
2391-
Choice1Of2 (SynEnumCase ( $1, $3, fst $5, snd $5, xmlDoc, mDecl, trivia))) }
2391+
Choice1Of2 (SynEnumCase ( $1, $3, fst $5, xmlDoc, mDecl, trivia))) }
23922392

23932393
/* The name of a union case */
23942394
unionCaseName:
@@ -2412,12 +2412,12 @@ firstUnionCaseDeclOfMany:
24122412
let mDecl = (rhs parseState 1) |> unionRangeWithXmlDoc xmlDoc
24132413
Choice2Of2 (SynUnionCase ( [], (SynIdent($1, None)), SynUnionCaseKind.Fields [], xmlDoc, None, mDecl, trivia)) }
24142414

2415-
| ident EQUALS constant opt_OBLOCKSEP
2415+
| ident EQUALS atomicExpr opt_OBLOCKSEP
24162416
{ let mEquals = rhs parseState 2
24172417
let trivia: SynEnumCaseTrivia = { BarRange = None; EqualsRange = mEquals }
24182418
let xmlDoc = grabXmlDoc(parseState, [], 1)
24192419
let mDecl = (rhs2 parseState 1 3) |> unionRangeWithXmlDoc xmlDoc
2420-
Choice1Of2 (SynEnumCase ([], SynIdent($1, None), fst $3, snd $3, xmlDoc, mDecl, trivia)) }
2420+
Choice1Of2 (SynEnumCase ([], SynIdent($1, None), fst $3, xmlDoc, mDecl, trivia)) }
24212421

24222422
| firstUnionCaseDecl opt_OBLOCKSEP
24232423
{ $1 }
@@ -2429,12 +2429,12 @@ firstUnionCaseDecl:
24292429
let mDecl = rhs2 parseState 1 3 |> unionRangeWithXmlDoc xmlDoc
24302430
Choice2Of2 (SynUnionCase ( [], SynIdent($1, None), SynUnionCaseKind.Fields $3, xmlDoc, None, mDecl, trivia)) }
24312431

2432-
| ident EQUALS constant opt_OBLOCKSEP
2432+
| ident EQUALS atomicExpr opt_OBLOCKSEP
24332433
{ let mEquals = rhs parseState 2
24342434
let trivia: SynEnumCaseTrivia = { BarRange = None; EqualsRange = mEquals }
24352435
let xmlDoc = grabXmlDoc(parseState, [], 1)
24362436
let mDecl = rhs2 parseState 1 3 |> unionRangeWithXmlDoc xmlDoc
2437-
Choice1Of2 (SynEnumCase ([], SynIdent($1, None), fst $3, snd $3, xmlDoc, mDecl, trivia)) }
2437+
Choice1Of2 (SynEnumCase ([], SynIdent($1, None), fst $3, xmlDoc, mDecl, trivia)) }
24382438

24392439
unionCaseReprElements:
24402440
| unionCaseReprElement STAR unionCaseReprElements

‎tests/FSharp.Compiler.ComponentTests/EmittedIL/Enums.fs‎

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
2+
3+
namespace FSharp.Compiler.ComponentTests.EmittedIL
4+
5+
open Xunit
6+
open FSharp.Test.Compiler
7+
8+
module Enums =
9+
10+
[<Fact>]
11+
let ``Arithmetic in enum definition works``() =
12+
FSharp """
13+
module Enums
14+
15+
let [<Literal>] one = 1
16+
17+
type Flags =
18+
| A = 1
19+
| B = (one <<< 1)
20+
| C = (one <<< (one * 2))
21+
"""
22+
|> withLangVersionPreview
23+
|> compile
24+
|> shouldSucceed
25+
|> verifyIL [
26+
""".field public static literal valuetype Enums/Flags A = int32(0x00000001)"""
27+
""".field public static literal valuetype Enums/Flags B = int32(0x00000002)"""
28+
""".field public static literal valuetype Enums/Flags C = int32(0x00000004)"""
29+
]
30+
31+
[<Fact>]
32+
let ``Enum with inconsistent case types errors with the right message``() =
33+
FSharp """
34+
module Enums
35+
36+
type E =
37+
| A = (1L <<< 0)
38+
| B = (1 <<< 1)
39+
"""
40+
|> withLangVersionPreview
41+
|> compile
42+
|> shouldFail
43+
|> withResult {
44+
Error = Error 1
45+
Range = { StartLine = 6
46+
StartColumn = 11
47+
EndLine = 6
48+
EndColumn = 20 }
49+
Message = "This expression was expected to have type
50+
'int64'
51+
but here has type
52+
'int' "
53+
}

‎tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -101,6 +101,7 @@
101101
<Compile Include="Conformance\UnitsOfMeasure\TypeChecker.fs" />
102102
<Compile Include="EmittedIL\CompilerGeneratedAttributeOnAccessors.fs" />
103103
<Compile Include="EmittedIL\EmptyArray.fs" />
104+
<Compile Include="EmittedIL\Enums.fs" />
104105
<Compile Include="EmittedIL\Literals.fs" />
105106
<Compile Include="EmittedIL\NoCompilerInlining.fs" />
106107
<Compile Include="EmittedIL\SkipLocalsInit.fs" />

‎tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -6067,19 +6067,17 @@ FSharp.Compiler.Syntax.SynConst: FSharp.Compiler.Text.Range Range(FSharp.Compile
60676067
FSharp.Compiler.Syntax.SynConst: Int32 Tag
60686068
FSharp.Compiler.Syntax.SynConst: Int32 get_Tag()
60696069
FSharp.Compiler.Syntax.SynConst: System.String ToString()
6070-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynConst get_value()
6071-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynConst value
6072-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynEnumCase NewSynEnumCase(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynIdent, FSharp.Compiler.Syntax.SynConst, FSharp.Compiler.Text.Range, FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia)
6070+
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynEnumCase NewSynEnumCase(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynIdent, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia)
6071+
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynExpr get_valueExpr()
6072+
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynExpr valueExpr
60736073
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynIdent get_ident()
60746074
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynIdent ident
60756075
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia get_trivia()
60766076
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia trivia
60776077
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range Range
60786078
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_Range()
60796079
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_range()
6080-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_valueRange()
60816080
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range range
6082-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range valueRange
60836081
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Xml.PreXmlDoc get_xmlDoc()
60846082
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Xml.PreXmlDoc xmlDoc
60856083
FSharp.Compiler.Syntax.SynEnumCase: Int32 Tag

‎tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -6067,19 +6067,17 @@ FSharp.Compiler.Syntax.SynConst: FSharp.Compiler.Text.Range Range(FSharp.Compile
60676067
FSharp.Compiler.Syntax.SynConst: Int32 Tag
60686068
FSharp.Compiler.Syntax.SynConst: Int32 get_Tag()
60696069
FSharp.Compiler.Syntax.SynConst: System.String ToString()
6070-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynConst get_value()
6071-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynConst value
6072-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynEnumCase NewSynEnumCase(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynIdent, FSharp.Compiler.Syntax.SynConst, FSharp.Compiler.Text.Range, FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia)
6070+
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynEnumCase NewSynEnumCase(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynIdent, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia)
6071+
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynExpr get_valueExpr()
6072+
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynExpr valueExpr
60736073
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynIdent get_ident()
60746074
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynIdent ident
60756075
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia get_trivia()
60766076
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia trivia
60776077
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range Range
60786078
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_Range()
60796079
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_range()
6080-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_valueRange()
60816080
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range range
6082-
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range valueRange
60836081
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Xml.PreXmlDoc get_xmlDoc()
60846082
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Xml.PreXmlDoc xmlDoc
60856083
FSharp.Compiler.Syntax.SynEnumCase: Int32 Tag

‎tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/EnumTypes/E_BoolUnderlyingType.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
// Test errors related to enums of invalid primitive/built-in types
44

55

6-
//<Expects id="FS0010" status="error">Unexpected keyword 'true' in union case</Expects>
6+
//<Expects id="FS0951" status="error">Literal enumerations must have type int, uint, int16, uint16, int64, uint64, byte, sbyte or char</Expects>
77

88
type EnumOfBool =
99
| A = true

‎tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/EnumTypes/E_DiscrimnantOfDifferentTypes.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
// #Regression #Conformance #ObjectOrientedTypes #Enums
22
// Verify that you cannot mix underlying types
33

4-
//<Expects id="FS0001" status="error" span="(8,7-8,13)">This expression was expected to have type. 'int' .but here has type. 'int64'</Expects>
4+
//<Expects id="FS0001" status="error" span="(8,11-8,13)">This expression was expected to have type. 'int' .but here has type. 'int64'</Expects>
55

66
type EnumType =
77
| D = 3

0 commit comments

Comments
 (0)