diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index f2bc644fce9..87850dba694 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/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 diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index b678aa9c9fa..57227c74818 100644 --- a/src/Compiler/pars.fsy +++ b/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: diff --git a/tests/service/data/SyntaxTree/Exception/Missing name 01.fs b/tests/service/data/SyntaxTree/Exception/Missing name 01.fs new file mode 100644 index 00000000000..3fce5c880c1 --- /dev/null +++ b/tests/service/data/SyntaxTree/Exception/Missing name 01.fs @@ -0,0 +1,5 @@ +module Module + +exception + +exception B diff --git a/tests/service/data/SyntaxTree/Exception/Missing name 01.fs.bsl b/tests/service/data/SyntaxTree/Exception/Missing name 01.fs.bsl new file mode 100644 index 00000000000..3bf7aea22b1 --- /dev/null +++ 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. diff --git a/tests/service/data/SyntaxTree/Exception/Missing name 02.fs b/tests/service/data/SyntaxTree/Exception/Missing name 02.fs new file mode 100644 index 00000000000..6e83464d73b --- /dev/null +++ b/tests/service/data/SyntaxTree/Exception/Missing name 02.fs @@ -0,0 +1,5 @@ +module Module + +exception [] + +exception B diff --git a/tests/service/data/SyntaxTree/Exception/Missing name 02.fs.bsl b/tests/service/data/SyntaxTree/Exception/Missing name 02.fs.bsl new file mode 100644 index 00000000000..d71336169b3 --- /dev/null +++ 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. diff --git a/tests/service/data/SyntaxTree/Exception/Missing name 03.fs b/tests/service/data/SyntaxTree/Exception/Missing name 03.fs new file mode 100644 index 00000000000..e21bb8265e5 --- /dev/null +++ b/tests/service/data/SyntaxTree/Exception/Missing name 03.fs @@ -0,0 +1,5 @@ +module Module + +exception internal + +exception B diff --git a/tests/service/data/SyntaxTree/Exception/Missing name 03.fs.bsl b/tests/service/data/SyntaxTree/Exception/Missing name 03.fs.bsl new file mode 100644 index 00000000000..2cb9b84bc5b --- /dev/null +++ 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.