Parser: recover on missing exception name

src/Compiler/Checking/CheckDeclarations.fs

@@ -2347,13 +2347,17 @@ module TcExceptionDeclarations =
         let binds3 = AddAugmentationDeclarations.AddGenericEqualityBindings cenv envFinal exnc
         binds1 @ binds2flat @ binds3, exnc, envFinal
 
-    let TcExnSignature (cenv: cenv) envInitial parent tpenv (SynExceptionSig(exnRepr=core; members=aug), scopem) = 
-        let g = cenv.g
-        let binds, exnc = TcExnDefnCore cenv envInitial parent core
-        let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons g cenv.amap scopem [exnc] envInitial) exnc 
-        let ecref = mkLocalEntityRef exnc
-        let vals, _ = TcTyconMemberSpecs cenv envMutRec (ContainerInfo(parent, Some(MemberOrValContainerInfo(ecref, None, None, NoSafeInitInfo, [])))) ModuleOrMemberBinding tpenv aug
-        binds, vals, ecref, envMutRec
+    let TcExnSignature (cenv: cenv) envInitial parent tpenv (SynExceptionSig(exnRepr=core; members=aug), scopem) =
+        match core with
+        | SynExceptionDefnRepr(caseName = SynUnionCase(ident = SynIdent(ident, _))) when ident.idText = "" ->
+            [], [], None, envInitial
+        | _ ->
+            let g = cenv.g
+            let binds, exnc = TcExnDefnCore cenv envInitial parent core
+            let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons g cenv.amap scopem [exnc] envInitial) exnc 
+            let ecref = mkLocalEntityRef exnc
+            let vals, _ = TcTyconMemberSpecs cenv envMutRec (ContainerInfo(parent, Some(MemberOrValContainerInfo(ecref, None, None, NoSafeInitInfo, [])))) ModuleOrMemberBinding tpenv aug
+            binds, vals, Some ecref, envMutRec
 
 
 
@@ -4807,11 +4811,14 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
           let env = MutRecBindingChecking.TcModuleAbbrevDecl cenv scopem env (id, p, m)
           return ([], [], []), env, env
 
-      | SynModuleDecl.Exception (SynExceptionDefn(exnRepr, withKeyword, ms, mExDefn), m) ->
-          let edef = SynExceptionDefn(exnRepr, withKeyword, desugarGetSetMembers ms, mExDefn)
-          let binds, decl, env = TcExceptionDeclarations.TcExnDefn cenv env parent (edef, scopem)
-          let defn = TMDefRec(true, [], [decl], binds |> List.map ModuleOrNamespaceBinding.Binding, m)
-          return ([defn], [], []), env, env
+      | SynModuleDecl.Exception (SynExceptionDefn(SynExceptionDefnRepr(caseName = SynUnionCase(ident = SynIdent(id, _))) as exnRepr, withKeyword, ms, mExDefn), m) ->
+          if id.idText = "" then
+              return ([], [], []), env, env
+          else
+              let edef = SynExceptionDefn(exnRepr, withKeyword, desugarGetSetMembers ms, mExDefn)
+              let binds, decl, env = TcExceptionDeclarations.TcExnDefn cenv env parent (edef, scopem)
+              let defn = TMDefRec(true, [], [decl], binds |> List.map ModuleOrNamespaceBinding.Binding, m)
+              return ([defn], [], []), env, env
 
       | SynModuleDecl.Types (typeDefs, m) -> 
           let scopem = unionRanges m scopem

src/Compiler/pars.fsy

@@ -2524,9 +2524,28 @@ exconDefn:
        SynExceptionDefn($1, mWith, optClassDefn, ($1.Range, optClassDefn) ||> unionRangeWithListBy (fun cd -> cd.Range) ) }
 
 /* Part of an exception definition */
-exconCore: 
+exconCore:
   | EXCEPTION opt_attributes opt_access exconIntro exconRepr
-     { SynExceptionDefnRepr($2, $4, $5, PreXmlDoc.Empty, $3, (match $5 with None -> rhs2 parseState 1 4 | Some p -> unionRanges (rangeOfLongIdent p) (rhs2 parseState 1 4))) }
+      { let m =
+            match $5 with
+            | None -> rhs2 parseState 1 4
+            | Some p -> unionRanges (rangeOfLongIdent p) (rhs2 parseState 1 4)
+        SynExceptionDefnRepr($2, $4, $5, PreXmlDoc.Empty, $3, m) }
+
+  | EXCEPTION opt_attributes opt_access recover
+      { let m =
+            match $3 with
+            | Some access -> unionRanges (rhs parseState 1) access.Range 
+            | _ ->
+
+            match $2 with
+            | [] -> rhs parseState 1
+            | attrs -> ((rhs parseState 1), attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range) 
+
+        let id = SynIdent(mkSynId m.EndRange "", None)
+        let unionCase = SynUnionCase([], id, SynUnionCaseKind.Fields [], PreXmlDoc.Empty, None, m, { BarRange = None })
+
+        SynExceptionDefnRepr($2, unionCase, None, PreXmlDoc.Empty, $3, m) }
 
 /* Part of an exception definition */
 exconIntro:

tests/service/data/SyntaxTree/Exception/Missing name 01.fs

@@ -0,0 +1,5 @@
+module Module
+
+exception
+
+exception B

tests/service/data/SyntaxTree/Exception/Missing name 01.fs.bsl

@@ -0,0 +1,30 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Exception/Missing name 01.fs", false, QualifiedNameOfFile Module,
+      [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Exception
+             (SynExceptionDefn
+                (SynExceptionDefnRepr
+                   ([],
+                    SynUnionCase
+                      ([], SynIdent (, None), Fields [], PreXmlDocEmpty, None,
+                       (3,0--3,9), { BarRange = None }), None,
+                    PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector), None,
+                    (3,0--3,9)), None, [], (3,0--3,9)), (3,0--3,9));
+           Exception
+             (SynExceptionDefn
+                (SynExceptionDefnRepr
+                   ([],
+                    SynUnionCase
+                      ([], SynIdent (B, None), Fields [], PreXmlDocEmpty, None,
+                       (5,10--5,11), { BarRange = None }), None,
+                    PreXmlDoc ((5,0), FSharp.Compiler.Xml.XmlDocCollector), None,
+                    (5,0--5,11)), None, [], (5,0--5,11)), (5,0--5,11))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--5,11), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,10)-(5,0) parse error Incomplete structured construct at or before this point in exception definition. Expected identifier or other token.

tests/service/data/SyntaxTree/Exception/Missing name 02.fs

@@ -0,0 +1,5 @@
+module Module
+
+exception [<A>]
+
+exception B

tests/service/data/SyntaxTree/Exception/Missing name 02.fs.bsl

@@ -0,0 +1,35 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Exception/Missing name 02.fs", false, QualifiedNameOfFile Module,
+      [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Exception
+             (SynExceptionDefn
+                (SynExceptionDefnRepr
+                   ([{ Attributes = [{ TypeName = SynLongIdent ([A], [], [None])
+                                       ArgExpr = Const (Unit, (3,12--3,13))
+                                       Target = None
+                                       AppliesToGetterAndSetter = false
+                                       Range = (3,12--3,13) }]
+                       Range = (3,10--3,15) }],
+                    SynUnionCase
+                      ([], SynIdent (, None), Fields [], PreXmlDocEmpty, None,
+                       (3,0--3,15), { BarRange = None }), None,
+                    PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector), None,
+                    (3,0--3,15)), None, [], (3,0--3,15)), (3,0--3,15));
+           Exception
+             (SynExceptionDefn
+                (SynExceptionDefnRepr
+                   ([],
+                    SynUnionCase
+                      ([], SynIdent (B, None), Fields [], PreXmlDocEmpty, None,
+                       (5,10--5,11), { BarRange = None }), None,
+                    PreXmlDoc ((5,0), FSharp.Compiler.Xml.XmlDocCollector), None,
+                    (5,0--5,11)), None, [], (5,0--5,11)), (5,0--5,11))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--5,11), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(5,0)-(5,9) parse error Unexpected keyword 'exception' in exception definition. Expected identifier or other token.

tests/service/data/SyntaxTree/Exception/Missing name 03.fs

@@ -0,0 +1,5 @@
+module Module
+
+exception internal
+
+exception B

tests/service/data/SyntaxTree/Exception/Missing name 03.fs.bsl

@@ -0,0 +1,31 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Exception/Missing name 03.fs", false, QualifiedNameOfFile Module,
+      [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Exception
+             (SynExceptionDefn
+                (SynExceptionDefnRepr
+                   ([],
+                    SynUnionCase
+                      ([], SynIdent (, None), Fields [], PreXmlDocEmpty, None,
+                       (3,0--3,18), { BarRange = None }), None,
+                    PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                    Some (Internal (3,10--3,18)), (3,0--3,18)), None, [],
+                 (3,0--3,18)), (3,0--3,18));
+           Exception
+             (SynExceptionDefn
+                (SynExceptionDefnRepr
+                   ([],
+                    SynUnionCase
+                      ([], SynIdent (B, None), Fields [], PreXmlDocEmpty, None,
+                       (5,10--5,11), { BarRange = None }), None,
+                    PreXmlDoc ((5,0), FSharp.Compiler.Xml.XmlDocCollector), None,
+                    (5,0--5,11)), None, [], (5,0--5,11)), (5,0--5,11))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--5,11), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,19)-(5,0) parse error Incomplete structured construct at or before this point in exception definition. Expected identifier or other token.