diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index bab9879dd03fdba1173343267d8f11561ead63c9..9f7aada60f3f57f9e6125911c060ca77d62a9013 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -2405,24 +2405,29 @@ attrUnionCaseDecls: { (fun xmlDoc -> [ $1 xmlDoc ]) } /* The core of a union case definition */ -attrUnionCaseDecl: - | opt_attributes opt_access unionCaseName opt_OBLOCKSEP +attrUnionCaseDecl: + | opt_attributes opt_access unionCaseName { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2)) let mDecl = rhs parseState 3 - (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3, UnionCaseFields [], xmlDoc, None, mDecl))) } + (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3, UnionCaseFields [], xmlDoc, None, mDecl))) } - | opt_attributes opt_access unionCaseName OF unionCaseRepr opt_OBLOCKSEP + | opt_attributes opt_access unionCaseName OF unionCaseRepr { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2)) let mDecl = rhs2 parseState 1 5 - (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3, UnionCaseFields $5, xmlDoc, None, mDecl))) } + (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3, UnionCaseFields $5, xmlDoc, None, mDecl))) } - | opt_attributes opt_access unionCaseName COLON topType opt_OBLOCKSEP + | opt_attributes opt_access unionCaseName OF recover + { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2)) + let mDecl = rhs2 parseState 1 4 + (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3, UnionCaseFields [], xmlDoc, None, mDecl))) } + + | opt_attributes opt_access unionCaseName COLON topType { if Option.isSome $2 then errorR(Error(FSComp.SR.parsUnionCasesCannotHaveVisibilityDeclarations(), rhs parseState 2)) libraryOnlyWarning(lhs parseState) let mDecl = rhs2 parseState 1 5 (fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3, UnionCaseFullType $5, xmlDoc, None, mDecl))) } - | opt_attributes opt_access unionCaseName EQUALS constant opt_OBLOCKSEP + | opt_attributes opt_access unionCaseName EQUALS constant { if Option.isSome $2 then errorR(Error(FSComp.SR.parsEnumFieldsCannotHaveVisibilityDeclarations(), rhs parseState 2)) let mDecl = rhs2 parseState 1 5 (fun xmlDoc -> Choice1Of2 (EnumCase ( $1, $3, $5, xmlDoc, mDecl))) } @@ -2517,13 +2522,16 @@ exconCore: { SynExceptionDefnRepr($2, $4, $5, $1, $3, (match $5 with None -> rhs2 parseState 1 4 | Some p -> unionRanges (rangeOfLongIdent p) (rhs2 parseState 1 4))) } /* Part of an exception definition */ -exconIntro: - | ident +exconIntro: + | ident { UnionCase([], $1, UnionCaseFields [], PreXmlDoc.Empty, None, lhs parseState) } - | ident OF unionCaseRepr + | ident OF unionCaseRepr { UnionCase([], $1, UnionCaseFields $3, PreXmlDoc.Empty, None, lhs parseState) } + | ident OF recover + { UnionCase([], $1, UnionCaseFields [], PreXmlDoc.Empty, None, lhs parseState) } + exconRepr: | /* EMPTY */ { None } diff --git a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/W_UnionCaseProduction01.fsx b/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/W_UnionCaseProduction01.fsx index 2efcd15a0353af7a40241ec59b5330fd595a9456..9b9226b076ecb0f2e1e96b6ec49eead6b7826f4b 100644 --- a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/W_UnionCaseProduction01.fsx +++ b/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/W_UnionCaseProduction01.fsx @@ -4,7 +4,8 @@ // | id -- nullary union case // | id of type * ... * type -- n-ary union case // | id : sig-spec -- n-ary union case -//This construct is deprecated: it is only for use in the F# library +//This construct is deprecated: it is only for use in the F# library +//This construct is deprecated: it is only for use in the F# library #light type T = | D : int -> T diff --git a/tests/service/ParserTests.fs b/tests/service/ParserTests.fs index 177a989cfd5c6235dbd302263cb5dd638dc5d180..c75b45fd848fbd21acf129f7cc624286341dc11d 100644 --- a/tests/service/ParserTests.fs +++ b/tests/service/ParserTests.fs @@ -19,3 +19,28 @@ let x = () | [ SynModuleDecl.Types ([ TypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members = [ _; _ ])) ], _) SynModuleDecl.Let _ ] -> () | _ -> failwith "Unexpected tree" + + [] + let ``Union case 01 - of`` () = + let parseResults = getParseResults """ +type U1 = + | A of + +type U2 = + | B of + | C + +let x = () + """ + let (|UnionWithCases|_|) typeDefn = + match typeDefn with + | TypeDefn (typeRepr = SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (unionCases = cases), _)) -> + cases |> List.map (fun (UnionCase (ident = ident)) -> ident.idText) |> Some + | _ -> None + + let (SynModuleOrNamespace (decls = decls)) = getSingleModuleLikeDecl parseResults + match decls with + | [ SynModuleDecl.Types ([ UnionWithCases ["A"]], _) + SynModuleDecl.Types ([ UnionWithCases ["B"; "C"] ], _) + SynModuleDecl.Let _ ] -> () + | _ -> failwith "Unexpected tree"