Parser: add recovery for missing fields after 'of' in union case (dot…

…net#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 <[email protected]> Co-authored-by: Phillip Carter <[email protected]>
xamarin · Feb 22, 2021 · 306a315 · 306a315
1 parent 0ad647e
commit 306a315
Show file tree

Hide file tree

Showing 3 changed files with 45 additions and 11 deletions.
diff --git 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/...a/Source/Conformance/BasicTypeAndModuleDefinitions/UnionTypes/W_UnionCaseProduction01.fsx b/...a/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
-//<Expects id="FS0042" span="(10,12-11,1)" status="warning">This construct is deprecated: it is only for use in the F# library</Expects>
+//<Expects id="FS0042" span="(11,12-11,24)" status="warning">This construct is deprecated: it is only for use in the F# library</Expects>
+//<Expects id="FS0042" span="(11,12-11,24)" status="warning">This construct is deprecated: it is only for use in the F# library</Expects>
 #light
 
 type T = | D : int -> T
diff --git 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"
+
+    [<Test>]
+    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"