From 722757e44a5874127dc564720902e5a5a50b12e8 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Sun, 20 Dec 2020 21:03:22 +0300 Subject: [PATCH] Parser: add recovery for missing fields after 'of' in union case (#10708) * Parser: add recovery for missing fields after 'of' in union case * Remove redundant opt_OBLOCKSEP * Recover in exceptions too * Fix test * Update test baseline * Add second warning * Update tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/W_UnionCaseProduction01.fsx Co-authored-by: Phillip Carter Co-authored-by: Phillip Carter --- src/fsharp/pars.fsy | 28 ++++++++++++------- .../UnionTypes/W_UnionCaseProduction01.fsx | 3 +- tests/service/ParserTests.fs | 25 +++++++++++++++++ 3 files changed, 45 insertions(+), 11 deletions(-) diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index bab9879dd..9f7aada60 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 2efcd15a0..9b9226b07 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 177a989cf..c75b45fd8 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" -- GitLab