Parser: recover on unfinished constructors

src/Compiler/pars.fsy

@@ -1606,27 +1606,79 @@ tyconDefn:
            let trivia: SynTypeDefnTrivia = { LeadingKeyword = leadingKeyword; EqualsRange = None; WithKeyword = None }
            SynTypeDefn($1, SynTypeDefnRepr.ObjectModel(SynTypeDefnKind.Augmentation mWithKwd, [], m), classDefns, None, m, trivia) }
 
-  | typeNameInfo opt_attributes opt_access opt_HIGH_PRECEDENCE_APP simplePatterns optAsSpec EQUALS tyconDefnRhsBlock
+  | typeNameInfo opt_attributes opt_access opt_HIGH_PRECEDENCE_APP opt_simplePatterns optAsSpec EQUALS tyconDefnRhsBlock
      { let vis, spats, az = $3, $5, $6
        let nameRange = rhs parseState 1
        let (tcDefRepr, mWith, members) = $8 nameRange
        let (SynComponentInfo(_, _, _, lid, _, _, _, _)) = $1
        let mEquals = rhs parseState 7
+
        // Gets the XML doc comments prior to the implicit constructor
-       let xmlDoc = grabXmlDoc(parseState, $2, 2)
+       let xmlDoc = grabXmlDoc (parseState, $2, 2)
+
        let m = match lid with [] -> rhs parseState 1 | _ -> rangeOfLid lid
-       let memberCtorPattern = SynMemberDefn.ImplicitCtor(vis, $2, spats, Option.map snd az, xmlDoc, m, { AsKeyword = Option.map fst az })
+
+       let memberCtorPattern =
+           spats |> Option.map (fun spats ->
+               SynMemberDefn.ImplicitCtor(vis, $2, spats, Option.bind snd az, xmlDoc, m, { AsKeyword = Option.map fst az })
+           )
+
        let tcDefRepr =
-         match tcDefRepr with
-         | SynTypeDefnRepr.ObjectModel (k, cspec, m) -> SynTypeDefnRepr.ObjectModel(k, memberCtorPattern :: cspec, m)
-         | _ -> reportParseErrorAt (rhs2 parseState 1 5) (FSComp.SR.parsOnlyClassCanTakeValueArguments()); tcDefRepr
+         match tcDefRepr, memberCtorPattern with
+         | SynTypeDefnRepr.ObjectModel(k, cspec, m), Some ctor ->
+             SynTypeDefnRepr.ObjectModel(k, ctor :: cspec, m)
+         | _, Some ctor ->
+             reportParseErrorAt (rhs2 parseState 1 5) (FSComp.SR.parsOnlyClassCanTakeValueArguments ())
+             tcDefRepr
+         | _ ->
+             match az with
+             | Some(_, Some id) ->
+                 reportParseErrorAt (rhs parseState 6) (FSComp.SR.tcLetAndDoRequiresImplicitConstructionSequence ())
+             | _ -> ()
+
+             tcDefRepr
+
        let declRange = unionRanges (rhs parseState 1) tcDefRepr.Range
        let mWhole = (declRange, members)
                     ||> unionRangeWithListBy (fun (mem: SynMemberDefn) -> mem.Range)
                     |> unionRangeWithXmlDoc xmlDoc
+
        fun leadingKeyword ->
            let trivia: SynTypeDefnTrivia = { LeadingKeyword = leadingKeyword; EqualsRange = Some mEquals; WithKeyword = mWith }
-           SynTypeDefn($1, tcDefRepr, members, Some memberCtorPattern, mWhole, trivia) }
+           SynTypeDefn($1, tcDefRepr, members, memberCtorPattern, mWhole, trivia) }
+
+  | typeNameInfo opt_attributes opt_access opt_HIGH_PRECEDENCE_APP opt_simplePatterns optAsSpec recover
+     { let vis, spats, az = $3, $5, $6
+       let (SynComponentInfo(longId = lid)) = $1
+       // Gets the XML doc comments prior to the implicit constructor
+       let xmlDoc = grabXmlDoc (parseState, $2, 2)
+       let m = match lid with [] -> rhs parseState 1 | _ -> rangeOfLid lid
+       let mName = $1.Range
+       let members, mWhole =
+           match spats, vis, az with
+           | Some spats, _, _ ->
+               let memberCtorPattern = SynMemberDefn.ImplicitCtor(vis, $2, spats, Option.bind snd az, xmlDoc, m, { AsKeyword = Option.map fst az })
+               [memberCtorPattern], unionRanges mName memberCtorPattern.Range
+
+           | _, _, Some(mAs, asId) ->
+               let mAs =
+                   asId |> Option.map (fun id ->
+                       reportParseErrorAt (rhs parseState 6) (FSComp.SR.tcLetAndDoRequiresImplicitConstructionSequence ())
+                       id.idRange
+                   )
+                   |> Option.defaultValue mAs
+
+               [], unionRanges mName mAs
+
+           | _, Some vis, _ ->
+               [], unionRanges mName vis.Range
+
+           | _ ->
+               [], mName
+
+       fun leadingKeyword ->
+           let trivia = { SynTypeDefnTrivia.Zero with LeadingKeyword = leadingKeyword }
+           SynTypeDefn($1, SynTypeDefnRepr.Simple(SynTypeDefnSimpleRepr.None(mName), mName), members, None, mName, trivia) }
 
 
 /* The right-hand-side of a type definition */
@@ -1998,14 +2050,54 @@ classDefnMember:
        let m = unionRanges mWholeBindLhs $7.Range |> unionRangeWithXmlDoc xmlDoc
        let mEquals = rhs parseState 6
        let expr = $7
-       let valSynData = SynValData (Some CtorMemberFlags, SynValInfo([SynInfo.InferSynArgInfoFromPat $4], SynInfo.unnamedRetVal), Option.map snd $5)
+       let valSynData = SynValData (Some CtorMemberFlags, SynValInfo([SynInfo.InferSynArgInfoFromPat $4], SynInfo.unnamedRetVal), Option.bind snd $5)
        let vis = $2
        let declPat = SynPat.LongIdent(SynLongIdent([mkSynId (rhs parseState 3) "new"], [], [None]), None, Some noInferredTypars, SynArgPats.Pats [$4], vis, rhs parseState 3)
        // Check that 'SynPatForConstructorDecl' matches this correctly
        assert (match declPat with SynPatForConstructorDecl _ -> true | _ -> false)
        let synBindingTrivia: SynBindingTrivia = { LeadingKeyword = SynLeadingKeyword.New mNew; InlineKeyword = None; EqualsRange = Some mEquals }
        [ SynMemberDefn.Member(SynBinding (None, SynBindingKind.Normal, false, false, $1, xmlDoc, valSynData, declPat, None, expr, mWholeBindLhs, DebugPointAtBinding.NoneAtInvisible, synBindingTrivia), m) ] }
 
+  | opt_attributes opt_access NEW atomicPattern optAsSpec ends_coming_soon_or_recover
+     { if not $6 then reportParseErrorAt (rhs parseState 6) (FSComp.SR.parsMissingMemberBody ())
+       let mNew = rhs parseState 3
+       let mAs = $5 |> Option.map (fun (mAs, id) -> id |> Option.map (fun id -> id.idRange) |> Option.defaultValue mAs)
+       let mEnd = mAs |> Option.defaultValue $4.Range
+       let xmlDoc = grabXmlDoc (parseState, $1, 1)
+       let m = unionRanges (rhs parseState 1) mEnd |> unionRangeWithXmlDoc xmlDoc
+       let expr = arbExpr ("new1", mEnd.EndRange)
+       let valSynData = SynValData (Some CtorMemberFlags, SynValInfo([SynInfo.InferSynArgInfoFromPat $4], SynInfo.unnamedRetVal), Option.bind snd $5)
+       let declPat = SynPat.LongIdent(SynLongIdent([mkSynId (rhs parseState 3) "new"], [], [None]), None, Some noInferredTypars, SynArgPats.Pats [$4], $2, rhs parseState 3)
+       assert (match declPat with SynPatForConstructorDecl _ -> true | _ -> false)
+       let synBindingTrivia: SynBindingTrivia = { LeadingKeyword = SynLeadingKeyword.New mNew; InlineKeyword = None; EqualsRange = None }
+       [ SynMemberDefn.Member(SynBinding(None, SynBindingKind.Normal, false, false, $1, xmlDoc, valSynData, declPat, None, expr, m, DebugPointAtBinding.NoneAtInvisible, synBindingTrivia), m) ] }
+
+  | opt_attributes opt_access NEW atomicPattern optAsSpec OBLOCKSEP
+     { reportParseErrorAt (rhs parseState 5) (FSComp.SR.parsMissingMemberBody ())
+       let mNew = rhs parseState 3
+       let mAs = $5 |> Option.map (fun (mAs, id) -> id |> Option.map (fun id -> id.idRange) |> Option.defaultValue mAs)
+       let mEnd = mAs |> Option.defaultValue $4.Range
+       let xmlDoc = grabXmlDoc (parseState, $1, 1)
+       let m = unionRanges (rhs parseState 1) mEnd |> unionRangeWithXmlDoc xmlDoc
+       let expr = arbExpr ("new2", mEnd.EndRange)
+       let valSynData = SynValData(Some CtorMemberFlags, SynValInfo([SynInfo.InferSynArgInfoFromPat $4], SynInfo.unnamedRetVal), Option.bind snd $5)
+       let declPat = SynPat.LongIdent(SynLongIdent([mkSynId (rhs parseState 3) "new"], [], [None]), None, Some noInferredTypars, SynArgPats.Pats [$4], $2, rhs parseState 3)
+       assert (match declPat with SynPatForConstructorDecl _ -> true | _ -> false)
+       let synBindingTrivia: SynBindingTrivia = { LeadingKeyword = SynLeadingKeyword.New mNew; InlineKeyword = None; EqualsRange = None }
+       [ SynMemberDefn.Member(SynBinding (None, SynBindingKind.Normal, false, false, $1, xmlDoc, valSynData, declPat, None, expr, m, DebugPointAtBinding.NoneAtInvisible, synBindingTrivia), m) ] }
+
+  | opt_attributes opt_access NEW recover opt_OBLOCKSEP
+     { let m = rhs2 parseState 1 3
+       let mNew = rhs parseState 3
+       let xmlDoc = grabXmlDoc (parseState, $1, 1)
+       let pat = patFromParseError (SynPat.Wild(mNew.EndRange))
+       let expr = arbExpr ("new3", mNew.EndRange)
+       let valSynData = SynValData(Some CtorMemberFlags, SynValInfo([SynInfo.InferSynArgInfoFromPat pat], SynInfo.unnamedRetVal), None)
+       let vis = $2
+       let declPat = SynPat.LongIdent(SynLongIdent([mkSynId (rhs parseState 3) "new"], [], [None]), None, Some noInferredTypars, SynArgPats.Pats [pat], vis, rhs parseState 3)
+       let synBindingTrivia: SynBindingTrivia = { LeadingKeyword = SynLeadingKeyword.New mNew; InlineKeyword = None; EqualsRange = None }
+       [ SynMemberDefn.Member(SynBinding(None, SynBindingKind.Normal, false, false, $1, xmlDoc, valSynData, declPat, None, expr, m, DebugPointAtBinding.NoneAtInvisible, synBindingTrivia), m) ] }
+
   | opt_attributes opt_access STATIC typeKeyword tyconDefn
      { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2))
        let leadingKeyword = SynTypeDefnLeadingKeyword.StaticType(rhs parseState 3, rhs parseState 4)
@@ -2154,7 +2246,10 @@ optAsSpec:
 
 asSpec:
   | AS ident
-     { rhs parseState 1, $2 }
+     { rhs parseState 1, Some $2 }
+
+  | AS recover
+     { rhs parseState 1, None }
 
 optBaseSpec:
   | baseSpec
@@ -3224,6 +3319,12 @@ simplePatternCommaList:
         | SynPat.Tuple(_, pats, commas, _) -> SynPat.Tuple(false, $1 :: pats, mComma :: commas, rhs2 parseState 1 3)
         | _ -> SynPat.Tuple(false, [$1; $3], [mComma], rhs2 parseState 1 3) }
 
+opt_simplePatterns:
+  | simplePatterns
+      { Some $1 }
+
+  | { None }
+
 simplePatterns:
   | LPAREN simplePatternCommaList rparen
       { let parenPat = SynPat.Paren($2, rhs2 parseState 1 3)

tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/codepage/codepage.fs

@@ -202,6 +202,4 @@ Parameter name: codepage")
         |> shouldFail
         |> withDiagnostics [
             (Error 10, Line 7, Col 10, Line 7, Col 11, "Unexpected character '�' in type name")
-            (Error 552, Line 7, Col 10, Line 8, Col 33, "Only class types may take value arguments")
-            (Error 10, Line 9, Col 14, Line 9, Col 17, "Unexpected keyword 'end' in implementation file. Expected incomplete structured construct at or before this point or other token.")
         ]

tests/FSharp.Compiler.ComponentTests/Conformance/LexicalFiltering/OffsideExceptions/OffsideExceptions.fs

@@ -474,6 +474,12 @@ raise (new Exception("exit 1"))
                         EndColumn = 40 }
               Message =
                "Unexpected end of quotation in expression. Expected incomplete structured construct at or before this point or other token." }
+            { Error = Error 3567
+              Range = { StartLine = 5
+                        StartColumn = 30
+                        EndLine = 5
+                        EndColumn = 31 }
+              Message = "Expecting member body" }
         ] |> ignore
 
     [<Theory; File "RelaxWhitespace2.fs">]

tests/fsharp/typecheck/sigs/neg69.vsbsl

@@ -1,3 +1,6 @@
+neg69.fsx(87,6,87,12): typecheck error FS0912: This declaration element is not permitted in an augmentation
+
+neg69.fsx(87,6,87,12): typecheck error FS0929: This type requires a definition
 
 neg69.fsx(88,43,88,44): parse error FS1241: Expected type argument or static argument
 

tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/AsDeclarations/SanityCheck02.fs

@@ -5,7 +5,7 @@
 // Verify error when using 'as' to get a thisPointer when you don't have an
 // implicit constructor.
 
-//<Expects id="FS0010" status="error">Unexpected keyword 'as' in type definition\. Expected '\(' or other token</Expects>
+//<Expects id="FS0963" status="error">This definition may only be used in a type with a primary constructor\. Consider adding arguments to your type definition, e\.g\. 'type X\(args\) = \.\.\.'\.</Expects>
 
 type Point as otherThisPtr =
 

tests/service/data/SyntaxTree/Type/As 01.fs

@@ -0,0 +1,3 @@
+module Module
+
+type T() as this = class end

tests/service/data/SyntaxTree/Type/As 01.fs.bsl

@@ -0,0 +1,30 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Type/As 01.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [T],
+                     PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (3,5--3,6)),
+                  ObjectModel
+                    (Class,
+                     [ImplicitCtor
+                        (None, [], SimplePats ([], [], (3,6--3,8)), Some this,
+                         PreXmlDoc ((3,6), FSharp.Compiler.Xml.XmlDocCollector),
+                         (3,5--3,6), { AsKeyword = Some (3,9--3,11) })],
+                     (3,19--3,28)), [],
+                  Some
+                    (ImplicitCtor
+                       (None, [], SimplePats ([], [], (3,6--3,8)), Some this,
+                        PreXmlDoc ((3,6), FSharp.Compiler.Xml.XmlDocCollector),
+                        (3,5--3,6), { AsKeyword = Some (3,9--3,11) })),
+                  (3,5--3,28), { LeadingKeyword = Type (3,0--3,4)
+                                 EqualsRange = Some (3,17--3,18)
+                                 WithKeyword = None })], (3,0--3,28))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--3,28), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))

tests/service/data/SyntaxTree/Type/As 02.fs

@@ -0,0 +1,3 @@
+module Module
+
+type T() as = class end

tests/service/data/SyntaxTree/Type/As 02.fs.bsl

@@ -0,0 +1,32 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Type/As 02.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [T],
+                     PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (3,5--3,6)),
+                  ObjectModel
+                    (Class,
+                     [ImplicitCtor
+                        (None, [], SimplePats ([], [], (3,6--3,8)), None,
+                         PreXmlDoc ((3,6), FSharp.Compiler.Xml.XmlDocCollector),
+                         (3,5--3,6), { AsKeyword = Some (3,9--3,11) })],
+                     (3,14--3,23)), [],
+                  Some
+                    (ImplicitCtor
+                       (None, [], SimplePats ([], [], (3,6--3,8)), None,
+                        PreXmlDoc ((3,6), FSharp.Compiler.Xml.XmlDocCollector),
+                        (3,5--3,6), { AsKeyword = Some (3,9--3,11) })),
+                  (3,5--3,23), { LeadingKeyword = Type (3,0--3,4)
+                                 EqualsRange = Some (3,12--3,13)
+                                 WithKeyword = None })], (3,0--3,23))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--3,23), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,12)-(3,13) parse error Unexpected symbol '=' in type definition. Expected identifier or other token.

tests/service/data/SyntaxTree/Type/As 03.fs

@@ -0,0 +1,3 @@
+module Module
+
+type T as this = class end

tests/service/data/SyntaxTree/Type/As 03.fs.bsl

@@ -0,0 +1,21 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Type/As 03.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [T],
+                     PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (3,5--3,6)),
+                  ObjectModel (Class, [], (3,17--3,26)), [], None, (3,5--3,26),
+                  { LeadingKeyword = Type (3,0--3,4)
+                    EqualsRange = Some (3,15--3,16)
+                    WithKeyword = None })], (3,0--3,26))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--3,26), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,7)-(3,14) parse error This definition may only be used in a type with a primary constructor. Consider adding arguments to your type definition, e.g. 'type X(args) = ...'.

tests/service/data/SyntaxTree/Type/As 04.fs

@@ -0,0 +1,3 @@
+module Module
+
+type T as = class end

tests/service/data/SyntaxTree/Type/As 04.fs.bsl

@@ -0,0 +1,21 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Type/As 04.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [T],
+                     PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (3,5--3,6)),
+                  ObjectModel (Class, [], (3,12--3,21)), [], None, (3,5--3,21),
+                  { LeadingKeyword = Type (3,0--3,4)
+                    EqualsRange = Some (3,10--3,11)
+                    WithKeyword = None })], (3,0--3,21))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--3,21), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,10)-(3,11) parse error Unexpected symbol '=' in type definition. Expected identifier or other token.

tests/service/data/SyntaxTree/Type/As 05.fs

@@ -0,0 +1,3 @@
+module Module
+
+type T() as this

tests/service/data/SyntaxTree/Type/As 05.fs.bsl

@@ -0,0 +1,25 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Type/As 05.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [T],
+                     PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (3,5--3,6)),
+                  Simple (None (3,5--3,6), (3,5--3,6)),
+                  [ImplicitCtor
+                     (None, [], SimplePats ([], [], (3,6--3,8)), Some this,
+                      PreXmlDoc ((3,6), FSharp.Compiler.Xml.XmlDocCollector),
+                      (3,5--3,6), { AsKeyword = Some (3,9--3,11) })], None,
+                  (3,5--3,6), { LeadingKeyword = Type (3,0--3,4)
+                                EqualsRange = None
+                                WithKeyword = None })], (3,0--3,6))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--3,6), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(4,0)-(4,0) parse error Incomplete structured construct at or before this point in type definition. Expected '=' or other token.

tests/service/data/SyntaxTree/Type/As 06.fs

@@ -0,0 +1,3 @@
+module Module
+
+type T() as

tests/service/data/SyntaxTree/Type/As 06.fs.bsl

@@ -0,0 +1,25 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Type/As 06.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [T],
+                     PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (3,5--3,6)),
+                  Simple (None (3,5--3,6), (3,5--3,6)),
+                  [ImplicitCtor
+                     (None, [], SimplePats ([], [], (3,6--3,8)), None,
+                      PreXmlDoc ((3,6), FSharp.Compiler.Xml.XmlDocCollector),
+                      (3,5--3,6), { AsKeyword = Some (3,9--3,11) })], None,
+                  (3,5--3,6), { LeadingKeyword = Type (3,0--3,4)
+                                EqualsRange = None
+                                WithKeyword = None })], (3,0--3,6))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--3,6), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(4,0)-(4,0) parse error Incomplete structured construct at or before this point in type definition. Expected identifier or other token.

tests/service/data/SyntaxTree/Type/As 07.fs

@@ -0,0 +1,5 @@
+module Module
+
+type T() as this
+
+()