Parser: recover on missing 'when' conditions

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -125,6 +125,7 @@
 * Fix FSI pretty printing to distinguish anonymous records (`{| ... |}`) from nominal records (`{ ... }`). ([Issue #6116](https://github.com/dotnet/fsharp/issues/6116), [PR #19919](https://github.com/dotnet/fsharp/pull/19919))
 * Fix dot-completion after indexed expressions (`a.[0].Data.`, `a[0].Data.`, `[1;2].Length.`) returning unrelated global completions instead of expression-typings members. ([Issue #4966](https://github.com/dotnet/fsharp/issues/4966), [PR #19934](https://github.com/dotnet/fsharp/pull/19934))
 * Quotations of `match s with "" -> _` no longer leak the `s <> null && s.Length = 0` lowering; the empty-string optimization moved from pattern-match compilation to the optimizer so quoted expressions keep `op_Equality(s, "")`. ([Issue #19873](https://github.com/dotnet/fsharp/issues/19873))
+* Parser: recover on unfinished abstract members ([PR #20070](https://github.com/dotnet/fsharp/pull/20070))
 
 ### Added
 

src/Compiler/Checking/CheckDeclarations.fs

@@ -3723,17 +3723,16 @@ module EstablishTypeDefinitionCores =
 
                         let abstractSlots = 
                             [ for synValSig, memberFlags in slotsigs do 
-
-                                  let (SynValSig(range=m)) = synValSig
-
-                                  CheckMemberFlags None NewSlotsOK OverridesOK memberFlags m
-
-                                  let slots = fst (TcAndPublishValSpec (cenv, envinner, containerInfo, ModuleOrMemberBinding, Some memberFlags, tpenv, synValSig))
-                                  // Multiple slots may be returned, e.g. for 
-                                  //    abstract P: int with get, set
-
-                                  for slot in slots do 
-                                      yield mkLocalValRef slot ]
+                                  let (SynValSig(ident = (SynIdent(id, _)); range = m)) = synValSig
+                                  if id.idText <> "" then
+                                      CheckMemberFlags None NewSlotsOK OverridesOK memberFlags m
+
+                                      let slots = fst (TcAndPublishValSpec (cenv, envinner, containerInfo, ModuleOrMemberBinding, Some memberFlags, tpenv, synValSig))
+                                      // Multiple slots may be returned, e.g. for 
+                                      //    abstract P: int with get, set
+
+                                      for slot in slots do 
+                                          yield mkLocalValRef slot ]
 
                         let kind = 
                             match kind with 

src/Compiler/SyntaxTree/ParseHelpers.fs

@@ -1136,3 +1136,95 @@ let mkLetBangExpression
             Trivia = { InKeyword = mIn }
             IsFromSource = true // User-written let!/use! bindings
         }
+
+let mkAbstractMember
+    parseState
+    attrs
+    (accessBeforeKeyword: SynAccess option)
+    memberFlags
+    (accessBeforeId: SynAccess option)
+    mInline
+    id
+    typeParams
+    typeWithConstraints
+    accessors
+    =
+    if Option.isSome accessBeforeKeyword then
+        errorR (Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier (), rhs parseState 2))
+
+    let (ty: SynType), arity = typeWithConstraints
+
+    let isInline, doc, explicitValTyparDecls =
+        Option.isSome mInline, grabXmlDoc (parseState, attrs, 1), typeParams
+
+    let mWith, (getSet, getSetRangeOpt: GetSetKeywords option, getterAccess, setterAccess) =
+        accessors
+
+    let getSetAdjuster arity =
+        match arity, getSet with
+        | SynValInfo([], _), SynMemberKind.Member -> SynMemberKind.PropertyGet
+        | _ -> getSet
+
+    let mWhole =
+        let m = rhs parseState 1
+
+        match getSetRangeOpt with
+        | None -> unionRanges m ty.Range
+        | Some gs -> unionRanges m gs.Range
+        |> unionRangeWithXmlDoc doc
+
+    [ accessBeforeKeyword; accessBeforeId; getterAccess; setterAccess ]
+    |> List.iter (function
+        | None -> ()
+        | Some access -> errorR (Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract (), access.Range)))
+
+    let mkFlags, leadingKeyword = memberFlags
+
+    let trivia =
+        {
+            LeadingKeyword = leadingKeyword
+            InlineKeyword = mInline
+            WithKeyword = mWith
+            EqualsRange = None
+        }
+
+    let vis2 = SynValSigAccess.Single None
+
+    let valSpfn =
+        SynValSig(attrs, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, None, mWhole, trivia)
+
+    let trivia: SynMemberDefnAbstractSlotTrivia = { GetSetKeywords = getSetRangeOpt }
+
+    [
+        SynMemberDefn.AbstractSlot(valSpfn, mkFlags (getSetAdjuster arity), mWhole, trivia)
+    ]
+
+let mkMatchClauses patternAndGuard patternResult (mNextBar: range option) nextClauses mLastOuter =
+    let (pat: SynPat), guard = patternAndGuard
+    let (mArrow: range option), (resultExpr: SynExpr) = patternResult
+    fun mBar ->
+        let m = unionRanges resultExpr.Range pat.Range
+        let clause = SynMatchClause(pat, guard, resultExpr, m, DebugPointAtTarget.Yes, { ArrowRange = mArrow; BarRange = mBar })
+
+        let clauses, mLast =
+            match nextClauses with
+            | Some patternClauses ->
+                let clauses, mLast = patternClauses mNextBar
+                clause :: clauses, mLast
+
+            | _ -> [clause], resultExpr.Range
+
+        clauses, mLastOuter |> Option.defaultValue mLast
+
+let mkMatchClausesRecoverMissingResult (patternAndGuard: SynPat * SynExpr option) exprDebugString (mExpr: range option) (mNextBar: range option) nextClauses mLastOuter =
+    let pat, guard = patternAndGuard
+    let mBeforeResult =
+        match mExpr with
+        | Some m -> m
+        | _ ->
+
+        match guard with
+        | Some expr -> expr.Range
+        | _ -> pat.Range
+    let patternResult = None, arbExpr (exprDebugString, mBeforeResult.EndRange)
+    mkMatchClauses patternAndGuard patternResult (mNextBar: range option) nextClauses mLastOuter

src/Compiler/SyntaxTree/ParseHelpers.fsi

@@ -285,3 +285,33 @@ val mkSynField:
         SynField
 
 val leadingKeywordIsAbstract: SynLeadingKeyword -> bool
+
+val mkAbstractMember:
+    parseState: IParseState ->
+    attrs: SynAttributeList list ->
+    accessBeforeKeyword: SynAccess option ->
+    abstractMemberFlags: (SynMemberKind -> SynMemberFlags) * SynLeadingKeyword ->
+        accessBeforeId: SynAccess option ->
+        mInline: range option ->
+        id: SynIdent ->
+        typeParams: SynValTyparDecls ->
+        typeWithConstraints: SynType * SynValInfo ->
+            accessors: range option * (SynMemberKind * GetSetKeywords option * SynAccess option * SynAccess option) ->
+                SynMemberDefn list
+
+val mkMatchClauses:
+    patternAndGuard: SynPat * SynExpr option ->
+    patternResult: range option * SynExpr ->
+    mNextBar: range option ->
+    nextClauses: (range option -> SynMatchClause list * range) option ->
+    mLastOuter: range option ->
+        (range option -> SynMatchClause list * range)
+
+val mkMatchClausesRecoverMissingResult:
+    patternAndGuard: SynPat * SynExpr option ->
+    exprDebugString: string ->
+    mExpr: range option ->
+    mNextBar: range option ->
+    nextClauses: (range option -> SynMatchClause list * range) option ->
+    mLastOuter: range option ->
+        (range option -> SynMatchClause list * range)

src/Compiler/pars.fsy

@@ -164,7 +164,7 @@ let parse_error_rich = Some(fun (ctxt: ParseErrorContext<_>) ->
 %type <SynTypeDefnSig list> tyconSpfnList
 %type <SynArgPats * Range> atomicPatsOrNamePatPairs
 %type <SynPat list> atomicPatterns
-%type <Range * SynExpr> patternResult
+%type <range option * SynExpr> patternResult
 %type <SynExpr> declExpr
 %type <SynExpr> minusExpr
 %type <SynExpr> appExpr
@@ -2058,27 +2058,33 @@ classDefnMember:
        [ SynMemberDefn.Interface(ty, None, None, rhs2 parseState 1 3) ] }
 
   | opt_attributes opt_access abstractMemberFlags opt_access opt_inline nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints classMemberSpfnGetSet opt_ODECLEND
-     { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2))
-       let ty, arity = $9
-       let isInline, doc, id, explicitValTyparDecls = (Option.isSome $5), grabXmlDoc(parseState, $1, 1), $6, $7
-       let mWith, (getSet, getSetRangeOpt, getterAccess, setterAccess) = $10
-       let getSetAdjuster arity = match arity, getSet with SynValInfo([], _), SynMemberKind.Member -> SynMemberKind.PropertyGet | _ -> getSet
-       let mWhole =
-           let m = rhs parseState 1
-           match getSetRangeOpt with
-           | None -> unionRanges m ty.Range
-           | Some gs -> unionRanges m gs.Range
-           |> unionRangeWithXmlDoc doc
-
-       [ $2; $4; getterAccess; setterAccess ]
-       |> List.iter (function None -> () | Some access -> errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(), access.Range)))
+     { mkAbstractMember parseState $1 $2 $3 $4 $5 $6 $7 $9 $10 }
+
+  | opt_attributes opt_access abstractMemberFlags opt_access opt_inline nameop opt_explicitValTyparDecls COLON recover opt_ODECLEND
+     { let id = $6
+       let typeWithConstraints = SynType.FromParseError(id.Range.EndRange), SynValInfo([], SynInfo.unnamedRetVal)
+       let accessors = None, (SynMemberKind.Member, None, None, None)
+       mkAbstractMember parseState $1 $2 $3 $4 $5 id $7 typeWithConstraints accessors }
+
+  | opt_attributes opt_access abstractMemberFlags opt_access opt_inline nameop opt_explicitValTyparDecls recover opt_ODECLEND
+     { let id = $6
+       let typeWithConstraints = SynType.FromParseError(id.Range.EndRange), SynValInfo([], SynInfo.unnamedRetVal)
+       let accessors = None, (SynMemberKind.Member, None, None, None)
+       mkAbstractMember parseState $1 $2 $3 $4 $5 id $7 typeWithConstraints accessors }
+
+  | opt_attributes opt_access abstractMemberFlags opt_access opt_inline recover opt_ODECLEND
+     { let mBeforeId =
+           match $2 with
+           | Some access -> access.Range
+           | _ ->
+               let _, leadingKeyword = $3
+               leadingKeyword.Range
 
-       let mkFlags, leadingKeyword = $3
-       let trivia = { LeadingKeyword = leadingKeyword; InlineKeyword = $5; WithKeyword = mWith; EqualsRange = None }
-       let vis2 = SynValSigAccess.Single(None)
-       let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, None, mWhole, trivia)
-       let trivia: SynMemberDefnAbstractSlotTrivia = { GetSetKeywords = getSetRangeOpt }
-       [ SynMemberDefn.AbstractSlot(valSpfn, mkFlags (getSetAdjuster arity), mWhole, trivia) ] }
+       let id = SynIdent(mkSynId mBeforeId.EndRange "", None)
+       let typeParams = SynValTyparDecls(None, true)
+       let typeWithConstraints = SynType.FromParseError(id.Range.EndRange), SynValInfo([], SynInfo.unnamedRetVal)
+       let accessors = None, (SynMemberKind.Member, None, None, None)
+       mkAbstractMember parseState $1 $2 $3 $4 $5 id typeParams typeWithConstraints accessors }
 
   | opt_attributes opt_access inheritsDefn
      { if not (isNil $1) then errorR(Error(FSComp.SR.parsAttributesIllegalOnInherit(), rhs parseState 1))
@@ -5055,66 +5061,64 @@ patternAndGuard:
 
 patternClauses:
   | patternAndGuard patternResult %prec prec_pat_pat_action
-     { let pat, guard = $1
-       let mArrow, resultExpr = $2
-       let mLast = resultExpr.Range
-       let m = unionRanges resultExpr.Range pat.Range
-       fun mBar ->
-           [SynMatchClause(pat, guard, resultExpr, m, DebugPointAtTarget.Yes, { ArrowRange = Some mArrow; BarRange = mBar })], mLast }
+     { mkMatchClauses $1 $2 None None None }
 
   | patternAndGuard patternResult barCanBeRightBeforeNull patternClauses
-     { let pat, guard = $1
-       let mArrow, resultExpr = $2
-       let mNextBar = rhs parseState 3 |> Some
-       let clauses, mLast = $4 mNextBar
-       let m = unionRanges resultExpr.Range pat.Range
-       fun mBar ->
-           (SynMatchClause(pat, guard, resultExpr, m, DebugPointAtTarget.Yes, { ArrowRange = Some mArrow; BarRange = mBar }) :: clauses), mLast }
+     { let mNextBar = rhs parseState 3 |> Some
+       mkMatchClauses $1 $2 mNextBar (Some $4) None }
 
   | patternAndGuard patternResult BAR barCanBeRightBeforeNull patternClauses
-     { let pat, guard = $1
-       let mArrow, resultExpr = $2
+     { let mNextBar = rhs parseState 3 |> Some
        let mBar1 = rhs parseState 3
        let mBar2 = rhs parseState 4
        reportParseErrorAt mBar2 (FSComp.SR.parsExpectingPattern ())
-       let clauses, mLast = Some mBar1 |> $5
-       let clauses = addEmptyMatchClause mBar1 mBar2 clauses
+       let patternClauses =
+           fun mNextBar ->
+               let clauses, mLast = Some mBar1 |> $5
+               let clauses = addEmptyMatchClause mBar1 mBar2 clauses
+               clauses, mLast
 
-       fun mBar ->
-           let m = unionRanges resultExpr.Range pat.Range
-           let trivia = { ArrowRange = Some mArrow; BarRange = mBar }
-           SynMatchClause(pat, guard, resultExpr, m, DebugPointAtTarget.Yes, trivia) :: clauses, mLast }
+       mkMatchClauses $1 $2 mNextBar (Some patternClauses) None }
 
   | patternAndGuard error barCanBeRightBeforeNull patternClauses
-     { let pat, guard = $1
-       let mNextBar = rhs parseState 3 |> Some
-       let clauses, mLast = $4 mNextBar
-       let patm = pat.Range
-       let m = guard |> Option.map (fun e -> unionRanges patm e.Range) |> Option.defaultValue patm
-       fun _mBar ->
-           (SynMatchClause(pat, guard, arbExpr ("patternClauses1", m.EndRange), m, DebugPointAtTarget.Yes, SynMatchClauseTrivia.Zero) :: clauses), mLast }
+     { let mNextBar = rhs parseState 3 |> Some
+       mkMatchClausesRecoverMissingResult $1 "patternClauses1" None mNextBar (Some $4) None }
 
   | patternAndGuard patternResult barCanBeRightBeforeNull recover
-     { let pat, guard = $1
-       let mArrow, resultExpr = $2
-       let mLast = rhs parseState 3
-       let m = unionRanges resultExpr.Range pat.Range
-       fun mBar ->
-           [SynMatchClause(pat, guard, resultExpr, m, DebugPointAtTarget.Yes, { ArrowRange = Some mArrow; BarRange = mBar })], mLast }
+     { let mLast = rhs parseState 3 |> Some
+       mkMatchClauses $1 $2 None None mLast }
 
   | patternAndGuard patternResult recover
-     { let pat, guard = $1
-       let mArrow, resultExpr = $2
-       let m = unionRanges resultExpr.Range pat.Range
-       fun mBar ->
-           [SynMatchClause(pat, guard, resultExpr, m, DebugPointAtTarget.Yes, { ArrowRange = Some mArrow; BarRange = mBar })], m }
+     { mkMatchClauses $1 $2 None None None }
 
   | patternAndGuard recover
-     { let pat, guard = $1
-       let patm = pat.Range
-       let m = guard |> Option.map (fun e -> unionRanges patm e.Range) |> Option.defaultValue patm
-       fun mBar ->
-           [SynMatchClause(pat, guard, arbExpr ("patternClauses2", m.EndRange), m, DebugPointAtTarget.Yes, { ArrowRange = None; BarRange = mBar })], m }
+     { mkMatchClausesRecoverMissingResult $1 "patternClauses2" None None None None }
+
+  | parenPattern WHEN patternResult %prec prec_recover
+     { let patternAndGuard = $1, None
+       let mWhen = rhs parseState 2
+       reportParseErrorAt mWhen (FSComp.SR.parsExpectingExpression ())
+       mkMatchClauses patternAndGuard $3 None None None }
+
+  | parenPattern WHEN %prec prec_recover
+     { let patternAndGuard = $1, None
+       let mWhen = rhs parseState 2
+       reportParseErrorAt mWhen (FSComp.SR.parsExpectingExpression ())
+       mkMatchClausesRecoverMissingResult patternAndGuard "patternClauses3" (Some mWhen) None None None }
+
+  | parenPattern WHEN barCanBeRightBeforeNull patternClauses %prec prec_recover
+     { let patternAndGuard = $1, None
+       let mWhen = rhs parseState 2
+       reportParseErrorAt mWhen (FSComp.SR.parsExpectingExpression ())
+       let mNextBar = rhs parseState 3 |> Some
+       mkMatchClausesRecoverMissingResult patternAndGuard "patternClauses4" (Some mWhen) mNextBar (Some $4) None }
+
+  | parenPattern WHEN barCanBeRightBeforeNull %prec prec_recover
+     { let patternAndGuard = $1, None
+       let mWhen = rhs parseState 2
+       reportParseErrorAt mWhen (FSComp.SR.parsExpectingExpression ())
+       let mLast = rhs parseState 3 |> Some
+       mkMatchClausesRecoverMissingResult patternAndGuard "patternClauses5" (Some mWhen) None None mLast }
 
 patternGuard:
   | WHEN declExpr
@@ -5127,7 +5131,7 @@ patternResult:
   | RARROW typedSequentialExprBlockR
       { let mArrow = rhs parseState 1
         let expr = $2 mArrow
-        mArrow, expr }
+        Some mArrow, expr }
 
 ifExprCases:
   | ifExprThen ifExprElifs

tests/service/data/SyntaxTree/Expression/Match - When 01.fs

@@ -0,0 +1,4 @@
+module Module
+
+match () with
+| _ when true -> ()

tests/service/data/SyntaxTree/Expression/Match - When 01.fs.bsl

@@ -0,0 +1,21 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Expression/Match - When 01.fs", false, QualifiedNameOfFile Module,
+      [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Expr
+             (Match
+                (Yes (3,0--3,13), Const (Unit, (3,6--3,8)),
+                 [SynMatchClause
+                    (Wild (4,2--4,3), Some (Const (Bool true, (4,9--4,13))),
+                     Const (Unit, (4,17--4,19)), (4,2--4,19), Yes,
+                     { ArrowRange = Some (4,14--4,16)
+                       BarRange = Some (4,0--4,1) })], (3,0--4,19),
+                 { MatchKeyword = (3,0--3,5)
+                   WithKeyword = (3,9--3,13) }), (3,0--4,19))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--4,19), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        WarnDirectives = []
+        CodeComments = [] }, set []))

tests/service/data/SyntaxTree/Expression/Match - When 02.fs

@@ -0,0 +1,4 @@
+module Module
+
+match () with
+| _ when -> ()