Skip to content

Commit 84dfab1

Browse files
auduchinokauduchinok
authored
Parser: recover on missing exception name (#15068)
1 parent b66de35 commit 84dfab1

File tree

8 files changed

+151
-14
lines changed

8 files changed

+151
-14
lines changed

‎src/Compiler/Checking/CheckDeclarations.fs‎

Lines changed: 19 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -2347,13 +2347,17 @@ module TcExceptionDeclarations =
23472347
let binds3 = AddAugmentationDeclarations.AddGenericEqualityBindings cenv envFinal exnc
23482348
binds1 @ binds2flat @ binds3, exnc, envFinal
23492349

2350-
let TcExnSignature (cenv: cenv) envInitial parent tpenv (SynExceptionSig(exnRepr=core; members=aug), scopem) =
2351-
let g = cenv.g
2352-
let binds, exnc = TcExnDefnCore cenv envInitial parent core
2353-
let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons g cenv.amap scopem [exnc] envInitial) exnc
2354-
let ecref = mkLocalEntityRef exnc
2355-
let vals, _ = TcTyconMemberSpecs cenv envMutRec (ContainerInfo(parent, Some(MemberOrValContainerInfo(ecref, None, None, NoSafeInitInfo, [])))) ModuleOrMemberBinding tpenv aug
2356-
binds, vals, ecref, envMutRec
2350+
let TcExnSignature (cenv: cenv) envInitial parent tpenv (SynExceptionSig(exnRepr=core; members=aug), scopem) =
2351+
match core with
2352+
| SynExceptionDefnRepr(caseName = SynUnionCase(ident = SynIdent(ident, _))) when ident.idText = "" ->
2353+
[], [], None, envInitial
2354+
| _ ->
2355+
let g = cenv.g
2356+
let binds, exnc = TcExnDefnCore cenv envInitial parent core
2357+
let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons g cenv.amap scopem [exnc] envInitial) exnc
2358+
let ecref = mkLocalEntityRef exnc
2359+
let vals, _ = TcTyconMemberSpecs cenv envMutRec (ContainerInfo(parent, Some(MemberOrValContainerInfo(ecref, None, None, NoSafeInitInfo, [])))) ModuleOrMemberBinding tpenv aug
2360+
binds, vals, Some ecref, envMutRec
23572361

23582362

23592363

@@ -4807,11 +4811,14 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
48074811
let env = MutRecBindingChecking.TcModuleAbbrevDecl cenv scopem env (id, p, m)
48084812
return ([], [], []), env, env
48094813

4810-
| SynModuleDecl.Exception (SynExceptionDefn(exnRepr, withKeyword, ms, mExDefn), m) ->
4811-
let edef = SynExceptionDefn(exnRepr, withKeyword, desugarGetSetMembers ms, mExDefn)
4812-
let binds, decl, env = TcExceptionDeclarations.TcExnDefn cenv env parent (edef, scopem)
4813-
let defn = TMDefRec(true, [], [decl], binds |> List.map ModuleOrNamespaceBinding.Binding, m)
4814-
return ([defn], [], []), env, env
4814+
| SynModuleDecl.Exception (SynExceptionDefn(SynExceptionDefnRepr(caseName = SynUnionCase(ident = SynIdent(id, _))) as exnRepr, withKeyword, ms, mExDefn), m) ->
4815+
if id.idText = "" then
4816+
return ([], [], []), env, env
4817+
else
4818+
let edef = SynExceptionDefn(exnRepr, withKeyword, desugarGetSetMembers ms, mExDefn)
4819+
let binds, decl, env = TcExceptionDeclarations.TcExnDefn cenv env parent (edef, scopem)
4820+
let defn = TMDefRec(true, [], [decl], binds |> List.map ModuleOrNamespaceBinding.Binding, m)
4821+
return ([defn], [], []), env, env
48154822

48164823
| SynModuleDecl.Types (typeDefs, m) ->
48174824
let scopem = unionRanges m scopem

‎src/Compiler/pars.fsy‎

Lines changed: 21 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2524,9 +2524,28 @@ exconDefn:
25242524
SynExceptionDefn($1, mWith, optClassDefn, ($1.Range, optClassDefn) ||> unionRangeWithListBy (fun cd -> cd.Range) ) }
25252525

25262526
/* Part of an exception definition */
2527-
exconCore:
2527+
exconCore:
25282528
| EXCEPTION opt_attributes opt_access exconIntro exconRepr
2529-
{ SynExceptionDefnRepr($2, $4, $5, PreXmlDoc.Empty, $3, (match $5 with None -> rhs2 parseState 1 4 | Some p -> unionRanges (rangeOfLongIdent p) (rhs2 parseState 1 4))) }
2529+
{ let m =
2530+
match $5 with
2531+
| None -> rhs2 parseState 1 4
2532+
| Some p -> unionRanges (rangeOfLongIdent p) (rhs2 parseState 1 4)
2533+
SynExceptionDefnRepr($2, $4, $5, PreXmlDoc.Empty, $3, m) }
2534+
2535+
| EXCEPTION opt_attributes opt_access recover
2536+
{ let m =
2537+
match $3 with
2538+
| Some access -> unionRanges (rhs parseState 1) access.Range
2539+
| _ ->
2540+
2541+
match $2 with
2542+
| [] -> rhs parseState 1
2543+
| attrs -> ((rhs parseState 1), attrs) ||> unionRangeWithListBy (fun (a: SynAttributeList) -> a.Range)
2544+
2545+
let id = SynIdent(mkSynId m.EndRange "", None)
2546+
let unionCase = SynUnionCase([], id, SynUnionCaseKind.Fields [], PreXmlDoc.Empty, None, m, { BarRange = None })
2547+
2548+
SynExceptionDefnRepr($2, unionCase, None, PreXmlDoc.Empty, $3, m) }
25302549

25312550
/* Part of an exception definition */
25322551
exconIntro:

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

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
module Module
2+
3+
exception
4+
5+
exception B

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

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
ImplFile
2+
(ParsedImplFileInput
3+
("/root/Exception/Missing name 01.fs", false, QualifiedNameOfFile Module,
4+
[], [],
5+
[SynModuleOrNamespace
6+
([Module], false, NamedModule,
7+
[Exception
8+
(SynExceptionDefn
9+
(SynExceptionDefnRepr
10+
([],
11+
SynUnionCase
12+
([], SynIdent (, None), Fields [], PreXmlDocEmpty, None,
13+
(3,0--3,9), { BarRange = None }), None,
14+
PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector), None,
15+
(3,0--3,9)), None, [], (3,0--3,9)), (3,0--3,9));
16+
Exception
17+
(SynExceptionDefn
18+
(SynExceptionDefnRepr
19+
([],
20+
SynUnionCase
21+
([], SynIdent (B, None), Fields [], PreXmlDocEmpty, None,
22+
(5,10--5,11), { BarRange = None }), None,
23+
PreXmlDoc ((5,0), FSharp.Compiler.Xml.XmlDocCollector), None,
24+
(5,0--5,11)), None, [], (5,0--5,11)), (5,0--5,11))],
25+
PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
26+
(1,0--5,11), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
27+
{ ConditionalDirectives = []
28+
CodeComments = [] }, set []))
29+
30+
(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‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
module Module
2+
3+
exception [<A>]
4+
5+
exception B

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

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
ImplFile
2+
(ParsedImplFileInput
3+
("/root/Exception/Missing name 02.fs", false, QualifiedNameOfFile Module,
4+
[], [],
5+
[SynModuleOrNamespace
6+
([Module], false, NamedModule,
7+
[Exception
8+
(SynExceptionDefn
9+
(SynExceptionDefnRepr
10+
([{ Attributes = [{ TypeName = SynLongIdent ([A], [], [None])
11+
ArgExpr = Const (Unit, (3,12--3,13))
12+
Target = None
13+
AppliesToGetterAndSetter = false
14+
Range = (3,12--3,13) }]
15+
Range = (3,10--3,15) }],
16+
SynUnionCase
17+
([], SynIdent (, None), Fields [], PreXmlDocEmpty, None,
18+
(3,0--3,15), { BarRange = None }), None,
19+
PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector), None,
20+
(3,0--3,15)), None, [], (3,0--3,15)), (3,0--3,15));
21+
Exception
22+
(SynExceptionDefn
23+
(SynExceptionDefnRepr
24+
([],
25+
SynUnionCase
26+
([], SynIdent (B, None), Fields [], PreXmlDocEmpty, None,
27+
(5,10--5,11), { BarRange = None }), None,
28+
PreXmlDoc ((5,0), FSharp.Compiler.Xml.XmlDocCollector), None,
29+
(5,0--5,11)), None, [], (5,0--5,11)), (5,0--5,11))],
30+
PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
31+
(1,0--5,11), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
32+
{ ConditionalDirectives = []
33+
CodeComments = [] }, set []))
34+
35+
(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‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
module Module
2+
3+
exception internal
4+
5+
exception B

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

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
ImplFile
2+
(ParsedImplFileInput
3+
("/root/Exception/Missing name 03.fs", false, QualifiedNameOfFile Module,
4+
[], [],
5+
[SynModuleOrNamespace
6+
([Module], false, NamedModule,
7+
[Exception
8+
(SynExceptionDefn
9+
(SynExceptionDefnRepr
10+
([],
11+
SynUnionCase
12+
([], SynIdent (, None), Fields [], PreXmlDocEmpty, None,
13+
(3,0--3,18), { BarRange = None }), None,
14+
PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
15+
Some (Internal (3,10--3,18)), (3,0--3,18)), None, [],
16+
(3,0--3,18)), (3,0--3,18));
17+
Exception
18+
(SynExceptionDefn
19+
(SynExceptionDefnRepr
20+
([],
21+
SynUnionCase
22+
([], SynIdent (B, None), Fields [], PreXmlDocEmpty, None,
23+
(5,10--5,11), { BarRange = None }), None,
24+
PreXmlDoc ((5,0), FSharp.Compiler.Xml.XmlDocCollector), None,
25+
(5,0--5,11)), None, [], (5,0--5,11)), (5,0--5,11))],
26+
PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
27+
(1,0--5,11), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
28+
{ ConditionalDirectives = []
29+
CodeComments = [] }, set []))
30+
31+
(3,19)-(5,0) parse error Incomplete structured construct at or before this point in exception definition. Expected identifier or other token.

0 commit comments

Comments
 (0)