未验证 提交 463ce710 编写于 作者: K kerams 提交者: GitHub

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: NTomas Grosup <tomasgrosup@microsoft.com>
上级 b5a99abd
......@@ -561,26 +561,38 @@ module TcRecdUnionAndEnumDeclarations =
let unionCasesR = unionCases |> List.map (TcUnionCaseDecl cenv env parent thisTy thisTyInst tpenv hasRQAAttribute)
unionCasesR |> CheckDuplicates (fun uc -> uc.Id) "union case"
let TcEnumDecl cenv env parent thisTy fieldTy (SynEnumCase(attributes=Attributes synAttrs; ident= SynIdent(id,_); value=v; xmlDoc=xmldoc; range=m)) =
let MakeEnumCaseSpec cenv env parent attrs thisTy caseRange (caseIdent: Ident) (xmldoc: PreXmlDoc) value =
let vis, _ = ComputeAccessAndCompPath env None caseRange None None parent
let vis = CombineReprAccess parent vis
if caseIdent.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(), caseIdent.idRange))
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some [])
Construct.NewRecdField true (Some value) caseIdent false thisTy false false [] attrs xmlDoc vis false
let TcEnumDecl cenv env tpenv parent thisTy fieldTy (SynEnumCase (attributes = Attributes synAttrs; ident = SynIdent (id, _); valueExpr = valueExpr; xmlDoc = xmldoc; range = caseRange)) =
let attrs = TcAttributes cenv env AttributeTargets.Field synAttrs
match v with
| SynConst.Bytes _
| SynConst.UInt16s _
| SynConst.UserNum _ -> error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), m))
| _ ->
let v = TcConst cenv fieldTy m env v
let vis, _ = ComputeAccessAndCompPath env None m None None parent
let vis = CombineReprAccess parent vis
if id.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(), id.idRange))
let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs
let xmlDoc = xmldoc.ToXmlDoc(checkXmlDocs, Some [])
Construct.NewRecdField true (Some v) id false thisTy false false [] attrs xmlDoc vis false
let TcEnumDecls (cenv: cenv) env parent thisTy enumCases =
let valueRange = valueExpr.Range
match valueExpr with
| SynExpr.Const (constant = SynConst.Bytes _ | SynConst.UInt16s _ | SynConst.UserNum _) ->
error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), valueRange))
| SynExpr.Const (synConst, _) ->
let konst = TcConst cenv fieldTy valueRange env synConst
MakeEnumCaseSpec cenv env parent attrs thisTy caseRange id xmldoc konst
| _ when cenv.g.langVersion.SupportsFeature LanguageFeature.ArithmeticInLiterals ->
let expr, actualTy, _ = TcExprOfUnknownType cenv env tpenv valueExpr
UnifyTypes cenv env valueRange fieldTy actualTy
match EvalLiteralExprOrAttribArg cenv.g expr with
| Expr.Const (konst, _, _) -> MakeEnumCaseSpec cenv env parent attrs thisTy caseRange id xmldoc konst
| _ -> error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), valueRange))
| _ ->
error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), valueRange))
let TcEnumDecls (cenv: cenv) env tpenv parent thisTy enumCases =
let g = cenv.g
let fieldTy = NewInferenceType g
let enumCases' = enumCases |> List.map (TcEnumDecl cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element"
let enumCases' = enumCases |> List.map (TcEnumDecl cenv env tpenv parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element"
fieldTy, enumCases'
//-------------------------------------------------------------------------
......@@ -3483,7 +3495,7 @@ module EstablishTypeDefinitionCores =
repr, baseValOpt, safeInitInfo
| SynTypeDefnSimpleRepr.Enum (decls, m) ->
let fieldTy, fields' = TcRecdUnionAndEnumDeclarations.TcEnumDecls cenv envinner innerParent thisTy decls
let fieldTy, fields' = TcRecdUnionAndEnumDeclarations.TcEnumDecls cenv envinner tpenv innerParent thisTy decls
let kind = TFSharpEnum
structLayoutAttributeCheck false
noCLIMutableAttributeCheck()
......@@ -3492,7 +3504,7 @@ module EstablishTypeDefinitionCores =
let vid = ident("value__", m)
let vfld = Construct.NewRecdField false None vid false fieldTy false false [] [] XmlDoc.Empty taccessPublic true
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 ]
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 ]
if not (ListSet.contains (typeEquiv g) fieldTy legitEnumTypes) then
errorR(Error(FSComp.SR.tcInvalidTypeForLiteralEnumeration(), m))
......
......@@ -1197,8 +1197,7 @@ type SynEnumCase =
| SynEnumCase of
attributes: SynAttributes *
ident: SynIdent *
value: SynConst *
valueRange: range *
valueExpr: SynExpr *
xmlDoc: PreXmlDoc *
range: range *
trivia: SynEnumCaseTrivia
......
......@@ -1349,8 +1349,7 @@ type SynEnumCase =
| SynEnumCase of
attributes: SynAttributes *
ident: SynIdent *
value: SynConst *
valueRange: range *
valueExpr: SynExpr *
xmlDoc: PreXmlDoc *
range: range *
trivia: SynEnumCaseTrivia
......
......@@ -2381,14 +2381,14 @@ attrUnionCaseDecl:
let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
Choice2Of2 (SynUnionCase ( $1, $3, SynUnionCaseKind.FullType $5, xmlDoc, None, mDecl, trivia))) }
| opt_attributes opt_access unionCaseName EQUALS constant
| opt_attributes opt_access unionCaseName EQUALS atomicExpr
{ if Option.isSome $2 then errorR(Error(FSComp.SR.parsEnumFieldsCannotHaveVisibilityDeclarations(), rhs parseState 2))
let mEquals = rhs parseState 4
let mDecl = rhs2 parseState 1 5
(fun (xmlDoc, mBar) ->
let trivia: SynEnumCaseTrivia = { BarRange = Some mBar; EqualsRange = mEquals }
let mDecl = unionRangeWithXmlDoc xmlDoc mDecl
Choice1Of2 (SynEnumCase ( $1, $3, fst $5, snd $5, xmlDoc, mDecl, trivia))) }
Choice1Of2 (SynEnumCase ( $1, $3, fst $5, xmlDoc, mDecl, trivia))) }
/* The name of a union case */
unionCaseName:
......@@ -2412,12 +2412,12 @@ firstUnionCaseDeclOfMany:
let mDecl = (rhs parseState 1) |> unionRangeWithXmlDoc xmlDoc
Choice2Of2 (SynUnionCase ( [], (SynIdent($1, None)), SynUnionCaseKind.Fields [], xmlDoc, None, mDecl, trivia)) }
| ident EQUALS constant opt_OBLOCKSEP
| ident EQUALS atomicExpr opt_OBLOCKSEP
{ let mEquals = rhs parseState 2
let trivia: SynEnumCaseTrivia = { BarRange = None; EqualsRange = mEquals }
let xmlDoc = grabXmlDoc(parseState, [], 1)
let mDecl = (rhs2 parseState 1 3) |> unionRangeWithXmlDoc xmlDoc
Choice1Of2 (SynEnumCase ([], SynIdent($1, None), fst $3, snd $3, xmlDoc, mDecl, trivia)) }
Choice1Of2 (SynEnumCase ([], SynIdent($1, None), fst $3, xmlDoc, mDecl, trivia)) }
| firstUnionCaseDecl opt_OBLOCKSEP
{ $1 }
......@@ -2429,12 +2429,12 @@ firstUnionCaseDecl:
let mDecl = rhs2 parseState 1 3 |> unionRangeWithXmlDoc xmlDoc
Choice2Of2 (SynUnionCase ( [], SynIdent($1, None), SynUnionCaseKind.Fields $3, xmlDoc, None, mDecl, trivia)) }
| ident EQUALS constant opt_OBLOCKSEP
| ident EQUALS atomicExpr opt_OBLOCKSEP
{ let mEquals = rhs parseState 2
let trivia: SynEnumCaseTrivia = { BarRange = None; EqualsRange = mEquals }
let xmlDoc = grabXmlDoc(parseState, [], 1)
let mDecl = rhs2 parseState 1 3 |> unionRangeWithXmlDoc xmlDoc
Choice1Of2 (SynEnumCase ([], SynIdent($1, None), fst $3, snd $3, xmlDoc, mDecl, trivia)) }
Choice1Of2 (SynEnumCase ([], SynIdent($1, None), fst $3, xmlDoc, mDecl, trivia)) }
unionCaseReprElements:
| unionCaseReprElement STAR unionCaseReprElements
......
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
namespace FSharp.Compiler.ComponentTests.EmittedIL
open Xunit
open FSharp.Test.Compiler
module Enums =
[<Fact>]
let ``Arithmetic in enum definition works``() =
FSharp """
module Enums
let [<Literal>] one = 1
type Flags =
| A = 1
| B = (one <<< 1)
| C = (one <<< (one * 2))
"""
|> withLangVersionPreview
|> compile
|> shouldSucceed
|> verifyIL [
""".field public static literal valuetype Enums/Flags A = int32(0x00000001)"""
""".field public static literal valuetype Enums/Flags B = int32(0x00000002)"""
""".field public static literal valuetype Enums/Flags C = int32(0x00000004)"""
]
[<Fact>]
let ``Enum with inconsistent case types errors with the right message``() =
FSharp """
module Enums
type E =
| A = (1L <<< 0)
| B = (1 <<< 1)
"""
|> withLangVersionPreview
|> compile
|> shouldFail
|> withResult {
Error = Error 1
Range = { StartLine = 6
StartColumn = 11
EndLine = 6
EndColumn = 20 }
Message = "This expression was expected to have type
'int64'
but here has type
'int' "
}
\ No newline at end of file
......@@ -101,6 +101,7 @@
<Compile Include="Conformance\UnitsOfMeasure\TypeChecker.fs" />
<Compile Include="EmittedIL\CompilerGeneratedAttributeOnAccessors.fs" />
<Compile Include="EmittedIL\EmptyArray.fs" />
<Compile Include="EmittedIL\Enums.fs" />
<Compile Include="EmittedIL\Literals.fs" />
<Compile Include="EmittedIL\NoCompilerInlining.fs" />
<Compile Include="EmittedIL\SkipLocalsInit.fs" />
......
......@@ -6067,9 +6067,9 @@ FSharp.Compiler.Syntax.SynConst: FSharp.Compiler.Text.Range Range(FSharp.Compile
FSharp.Compiler.Syntax.SynConst: Int32 Tag
FSharp.Compiler.Syntax.SynConst: Int32 get_Tag()
FSharp.Compiler.Syntax.SynConst: System.String ToString()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynConst get_value()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynConst value
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)
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)
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynExpr get_valueExpr()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynExpr valueExpr
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynIdent get_ident()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynIdent ident
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia get_trivia()
......@@ -6077,9 +6077,7 @@ FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.SyntaxTrivia.SynEnumCaseTriv
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range Range
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_Range()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_range()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_valueRange()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range range
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range valueRange
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Xml.PreXmlDoc get_xmlDoc()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Xml.PreXmlDoc xmlDoc
FSharp.Compiler.Syntax.SynEnumCase: Int32 Tag
......@@ -6067,9 +6067,9 @@ FSharp.Compiler.Syntax.SynConst: FSharp.Compiler.Text.Range Range(FSharp.Compile
FSharp.Compiler.Syntax.SynConst: Int32 Tag
FSharp.Compiler.Syntax.SynConst: Int32 get_Tag()
FSharp.Compiler.Syntax.SynConst: System.String ToString()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynConst get_value()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynConst value
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)
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)
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynExpr get_valueExpr()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynExpr valueExpr
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynIdent get_ident()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Syntax.SynIdent ident
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.SyntaxTrivia.SynEnumCaseTrivia get_trivia()
......@@ -6077,9 +6077,7 @@ FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.SyntaxTrivia.SynEnumCaseTriv
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range Range
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_Range()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_range()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range get_valueRange()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range range
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Text.Range valueRange
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Xml.PreXmlDoc get_xmlDoc()
FSharp.Compiler.Syntax.SynEnumCase: FSharp.Compiler.Xml.PreXmlDoc xmlDoc
FSharp.Compiler.Syntax.SynEnumCase: Int32 Tag
......@@ -3,7 +3,7 @@
// Test errors related to enums of invalid primitive/built-in types
//<Expects id="FS0010" status="error">Unexpected keyword 'true' in union case</Expects>
//<Expects id="FS0951" status="error">Literal enumerations must have type int, uint, int16, uint16, int64, uint64, byte, sbyte or char</Expects>
type EnumOfBool =
| A = true
......
// #Regression #Conformance #ObjectOrientedTypes #Enums
// Verify that you cannot mix underlying types
//<Expects id="FS0001" status="error" span="(8,7-8,13)">This expression was expected to have type. 'int' .but here has type. 'int64'</Expects>
//<Expects id="FS0001" status="error" span="(8,11-8,13)">This expression was expected to have type. 'int' .but here has type. 'int64'</Expects>
type EnumType =
| D = 3
......
......@@ -4,8 +4,8 @@
//<Expects id="FS0951" span="(19,5-20,16)" status="error">Literal enumerations must have type int, uint, int16, uint16, int64, uint64, byte, sbyte or char</Expects>
//<Expects id="FS0886" span="(23,7-23,13)" status="error">This is not a valid value for an enumeration literal</Expects>
//<Expects id="FS0886" span="(27,7-27,13)" status="error">This is not a valid value for an enumeration literal</Expects>
//<Expects id="FS0886" span="(23,11-23,13)" status="error">This is not a valid value for an enumeration literal</Expects>
//<Expects id="FS0886" span="(27,11-27,13)" status="error">This is not a valid value for an enumeration literal</Expects>
//<Expects id="FS0951" span="(32,5-33,13)" status="error">Literal enumerations must have type int, uint, int16, uint16, int64, uint64, byte, sbyte or char</Expects>
//<Expects id="FS0951" span="(37,5-38,14)" status="error">Literal enumerations must have type int, uint, int16, uint16, int64, uint64, byte, sbyte or char</Expects>
//<Expects id="FS0951" span="(41,5-42,15)" status="error">Literal enumerations must have type int, uint, int16, uint16, int64, uint64, byte, sbyte or char</Expects>
......
// #Regression #Diagnostics
// Regression test for FSHARP1.0:1729
// Notice that the bug was in the IDE, but a compiler test is equally useful.
//<Expects id="FS0886" span="(10,7-10,13)" status="error">This is not a valid value for an enumeration literal</Expects>
//<Expects id="FS0886" span="(14,7-14,13)" status="error">This is not a valid value for an enumeration literal</Expects>
//<Expects id="FS0886" span="(10,11-10,13)" status="error">This is not a valid value for an enumeration literal</Expects>
//<Expects id="FS0886" span="(14,11-14,13)" status="error">This is not a valid value for an enumeration literal</Expects>
#light
// Shouldn't work
......
......@@ -17,9 +17,9 @@ type Foo = One = 0x00000001
| ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [
SynModuleDecl.Types(typeDefns = [
SynTypeDefn.SynTypeDefn(typeRepr =
SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ SynEnumCase.SynEnumCase(valueRange = r) ])))])
SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ SynEnumCase.SynEnumCase(valueExpr = e) ])))])
]) ])) ->
assertRange (2, 17) (2, 27) r
assertRange (2, 17) (2, 27) e.Range
| _ -> Assert.Fail "Could not get valid AST"
[<Test>]
......@@ -36,11 +36,11 @@ type Foo =
| ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [
SynModuleDecl.Types(typeDefns = [
SynTypeDefn.SynTypeDefn(typeRepr =
SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ SynEnumCase.SynEnumCase(valueRange = r1)
SynEnumCase.SynEnumCase(valueRange = r2) ])))])
SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ SynEnumCase.SynEnumCase(valueExpr = e1)
SynEnumCase.SynEnumCase(valueExpr = e2) ])))])
]) ])) ->
assertRange (3, 13) (3, 23) r1
assertRange (4, 12) (4, 13) r2
assertRange (3, 13) (3, 23) e1.Range
assertRange (4, 12) (4, 13) e2.Range
| _ -> Assert.Fail "Could not get valid AST"
[<Test>]
......
......@@ -57,7 +57,7 @@ let ``Visit enum definition test`` () =
let parseTree = parseSourceCode("C:\\test.fs", source)
match SyntaxTraversal.Traverse(pos0, parseTree, visitor) with
| Some [ SynEnumCase (_, SynIdent(id1,_), _, _, _, _, _); SynEnumCase (_, SynIdent(id2,_), _, _, _, _, _) ] when id1.idText = "A" && id2.idText = "B" -> ()
| Some [ SynEnumCase (ident = SynIdent (id1, _)); SynEnumCase (ident = SynIdent (id2, _)) ] when id1.idText = "A" && id2.idText = "B" -> ()
| _ -> failwith "Did not visit enum definition"
[<Test>]
......
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册