Merge main to release/dev17.8

global.json

@@ -12,7 +12,7 @@
         "Microsoft.VisualStudio.Component.FSharp"
       ]
     },
-    "xcopy-msbuild": "17.6.0-2"
+    "xcopy-msbuild": "17.7.0-test"
   },
   "native-tools": {
     "perl": "5.38.0.1"

src/Compiler/SyntaxTree/LexFilter.fs

@@ -46,7 +46,7 @@ type Context =
     | CtxtElse of Position
     | CtxtDo of Position
     | CtxtInterfaceHead of Position
-    | CtxtTypeDefns of Position    // 'type <here> =', not removed when we find the "="
+    | CtxtTypeDefns of Position * equalsEndPos: Position option // 'type <here> =', not removed when we find the "="
 
     | CtxtNamespaceHead of Position * token
     | CtxtModuleHead of Position * token * LexingModuleAttributes * isNested: bool
@@ -69,7 +69,7 @@ type Context =
     member c.StartPos =
         match c with
         | CtxtNamespaceHead (p, _) | CtxtModuleHead (p, _, _, _) | CtxtException p | CtxtModuleBody (p, _) | CtxtNamespaceBody p
-        | CtxtLetDecl (_, p) | CtxtDo p | CtxtInterfaceHead p | CtxtTypeDefns p | CtxtParen (_, p) | CtxtMemberHead p | CtxtMemberBody p
+        | CtxtLetDecl (_, p) | CtxtDo p | CtxtInterfaceHead p | CtxtTypeDefns(p, _) | CtxtParen (_, p) | CtxtMemberHead p | CtxtMemberBody p
         | CtxtWithAsLet p
         | CtxtWithAsAugment p
         | CtxtMatchClauses (_, p) | CtxtIf p | CtxtMatch p | CtxtFor p | CtxtWhile p | CtxtWhen p | CtxtFunction p | CtxtFun p | CtxtTry p | CtxtThen p | CtxtElse p | CtxtVanilla (p, _)
@@ -742,7 +742,7 @@ type LexFilterImpl (
 
     //let indexerNotationWithoutDot = lexbuf.SupportsFeature LanguageFeature.IndexerNotationWithoutDot
 
-    let tryPushCtxt strict tokenTup (newCtxt: Context) =
+    let tryPushCtxt strict ignoreIndent tokenTup (newCtxt: Context) =
         let rec undentationLimit strict stack =
             match newCtxt, stack with
             | _, [] -> PositionWithColumn(newCtxt.StartPos, -1)
@@ -960,8 +960,10 @@ type LexFilterImpl (
             // These contexts can have their contents exactly aligning
             | _, (CtxtParen _ | CtxtFor _ | CtxtWhen _ | CtxtWhile _ | CtxtTypeDefns _ | CtxtMatch _ | CtxtModuleBody (_, true) | CtxtNamespaceBody _ | CtxtTry _ | CtxtMatchClauses _ | CtxtSeqBlock _ as limitCtxt :: _)
                       -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol)
-    
+
         let isCorrectIndent =
+            if ignoreIndent then true else
+
             match newCtxt with
             // Don't bother to check pushes of Vanilla blocks since we've
             // always already pushed a SeqBlock at this position.
@@ -992,7 +994,7 @@ type LexFilterImpl (
         true
 
     let pushCtxt tokenTup newCtxt =
-        tryPushCtxt false tokenTup newCtxt |> ignore
+        tryPushCtxt false false tokenTup newCtxt |> ignore
 
     let rec popCtxt() =
         match offsideStack with
@@ -1008,6 +1010,10 @@ type LexFilterImpl (
 
     let replaceCtxt p ctxt = popCtxt(); pushCtxt p ctxt
 
+    let replaceCtxtIgnoreIndent p ctxt =
+        popCtxt()
+        tryPushCtxt false true p ctxt |> ignore
+
     //----------------------------------------------------------------------------
     // Peek ahead at a token, either from the old lexer or from our delayedStack
     //--------------------------------------------------------------------------
@@ -1679,7 +1685,7 @@ type LexFilterImpl (
                             //  | B
                             //
                             //  <TOKEN>    <-- close the type context sequence block here *)
-                        | _, CtxtTypeDefns posType :: _ when offsidePos.Column = posType.Column && not (isTypeSeqBlockElementContinuator token) -> -1
+                        | _, CtxtTypeDefns(posType, _) :: _ when offsidePos.Column = posType.Column && not (isTypeSeqBlockElementContinuator token) -> -1
 
                             // This ensures we close a namespace body when we see the next namespace definition
                             //
@@ -1822,7 +1828,7 @@ type LexFilterImpl (
             popCtxt()
             reprocess()
 
-        | _, CtxtTypeDefns offsidePos :: _
+        | _, CtxtTypeDefns(offsidePos, _) :: _
                 when isSemiSemi || (if relaxWhitespace2OffsideRule || isTypeContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column ->
             if debug then dprintf "token at column %d is offside from TYPE(offsidePos=%a)! pop and reprocess\n" tokenStartCol outputPos offsidePos
             popCtxt()
@@ -2076,8 +2082,9 @@ type LexFilterImpl (
             pushCtxtSeqBlock tokenTup AddBlockEnd
             returnToken tokenLexbufState token
 
-        | EQUALS, CtxtTypeDefns _ :: _ ->
+        | EQUALS, CtxtTypeDefns(p, _) :: _ ->
             if debug then dprintf "CtxType: EQUALS, pushing CtxtSeqBlock\n"
+            replaceCtxtIgnoreIndent tokenTup (CtxtTypeDefns(p, Some tokenTup.EndPos))
             pushCtxtSeqBlock tokenTup AddBlockEnd
             returnToken tokenLexbufState token
 
@@ -2202,7 +2209,7 @@ type LexFilterImpl (
             let leadingBar = match (peekNextToken()) with BAR -> true | _ -> false
 
             if debug then dprintf "WITH, pushing CtxtMatchClauses, lookaheadTokenStartPos = %a, tokenStartPos = %a\n" outputPos lookaheadTokenStartPos outputPos tokenStartPos
-            tryPushCtxt strictIndentation lookaheadTokenTup (CtxtMatchClauses(leadingBar, lookaheadTokenStartPos)) |> ignore
+            tryPushCtxt strictIndentation false lookaheadTokenTup (CtxtMatchClauses(leadingBar, lookaheadTokenStartPos)) |> ignore
 
             returnToken tokenLexbufState OWITH
 
@@ -2385,22 +2392,42 @@ type LexFilterImpl (
             pushCtxt tokenTup (CtxtFun tokenStartPos)
             returnToken tokenLexbufState OFUN
 
+        // type I = interface .... end
+        | INTERFACE, CtxtSeqBlock _ :: CtxtTypeDefns(typePos, Some equalsEndPos) :: _ when
+                (tokenTup.LastTokenPos = equalsEndPos &&
+
+                 // Allow deindenting interface representation when started after `=`:
+                 //
+                 // type I = interface
+                 //   abstract P: int
+                 // end
+
+                 let allowDeindent = tokenTup.EndPos.Line = equalsEndPos.Line
+
+                 let lookaheadTokenTup = peekNextTokenTup ()
+                 let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup
+                 match lookaheadTokenTup.Token with
+                 | END ->
+                     lookaheadTokenStartPos.Column >= typePos.Column
+
+                 | DEFAULT | OVERRIDE | INTERFACE | NEW | TYPE | STATIC | MEMBER | ABSTRACT | INHERIT | LBRACK_LESS ->
+                     let limitPos = if allowDeindent then typePos else tokenTup.StartPos
+                     lookaheadTokenStartPos.Column >= limitPos.Column + 1
+
+                 | _ ->
+                     false) ->
+
+            if debug then dprintf "INTERFACE, pushing CtxtParen, tokenStartPos = %a\n" outputPos tokenStartPos
+            pushCtxt tokenTup (CtxtParen (token, tokenStartPos))
+            pushCtxtSeqBlock tokenTup AddBlockEnd
+            returnToken tokenLexbufState token
+
+        // type C with interface .... with
+        // type C = interface .... with
         | INTERFACE, _ ->
-            let lookaheadTokenTup = peekNextTokenTup()
-            let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup
-            match lookaheadTokenTup.Token with
-            // type I = interface .... end
-            | DEFAULT | OVERRIDE | INTERFACE | NEW | TYPE | STATIC | END | MEMBER | ABSTRACT | INHERIT | LBRACK_LESS ->
-                if debug then dprintf "INTERFACE, pushing CtxtParen, tokenStartPos = %a, lookaheadTokenStartPos = %a\n" outputPos tokenStartPos outputPos lookaheadTokenStartPos
-                pushCtxt tokenTup (CtxtParen (token, tokenStartPos))
-                pushCtxtSeqBlock tokenTup AddBlockEnd
-                returnToken tokenLexbufState token
-            // type C with interface .... with
-            // type C = interface .... with
-            | _ ->
-                if debug then dprintf "INTERFACE, pushing CtxtInterfaceHead, tokenStartPos = %a, lookaheadTokenStartPos = %a\n" outputPos tokenStartPos outputPos lookaheadTokenStartPos
-                pushCtxt tokenTup (CtxtInterfaceHead tokenStartPos)
-                returnToken tokenLexbufState OINTERFACE_MEMBER
+            if debug then dprintf "INTERFACE, pushing CtxtInterfaceHead, tokenStartPos = %a, lookaheadTokenStartPos \n" outputPos tokenStartPos
+            pushCtxt tokenTup (CtxtInterfaceHead tokenStartPos)
+            returnToken tokenLexbufState OINTERFACE_MEMBER
 
         | CLASS, _ ->
             if debug then dprintf "CLASS, pushing CtxtParen(%a)\n" outputPos tokenStartPos
@@ -2411,7 +2438,7 @@ type LexFilterImpl (
         | TYPE, _ ->
             insertComingSoonTokens("TYPE", TYPE_COMING_SOON, TYPE_IS_HERE)
             if debug then dprintf "TYPE, pushing CtxtTypeDefns(%a)\n" outputPos tokenStartPos
-            pushCtxt tokenTup (CtxtTypeDefns tokenStartPos)
+            pushCtxt tokenTup (CtxtTypeDefns(tokenStartPos, None))
             pool.Return tokenTup
             hwTokenFetch useBlockRule
 
@@ -2582,7 +2609,7 @@ type LexFilterImpl (
         pushCtxtSeqBlockAt strictIndentation false fallbackToken (peekNextTokenTup ()) addBlockEnd
 
     and pushCtxtSeqBlockAt strict (useFallback: bool) (fallbackToken: TokenTup) (tokenTup: TokenTup) addBlockEnd =
-         let pushed = tryPushCtxt strict tokenTup (CtxtSeqBlock(FirstInSeqBlock, startPosOfTokenTup tokenTup, addBlockEnd))
+         let pushed = tryPushCtxt strict false tokenTup (CtxtSeqBlock(FirstInSeqBlock, startPosOfTokenTup tokenTup, addBlockEnd))
          if not pushed && useFallback then
              // The upcoming token isn't sufficiently indented to start the new context.
              // The parser expects proper contexts structure, so we push a new recovery context at the fallback token position.

src/Compiler/pars.fsy

@@ -1773,7 +1773,7 @@ tyconClassDefn:
   | classOrInterfaceOrStruct classDefnBlock END
      { false, ($1, $2), Some(rhs2 parseState 1 3) }
 
-  | classOrInterfaceOrStruct classDefnBlock recover
+  | classOrInterfaceOrStruct classDefnBlock ends_coming_soon_or_recover
      { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedClassInterfaceOrStruct())
        let m = (rhs parseState 1, $2) ||> unionRangeWithListBy (fun (d: SynMemberDefn) -> d.Range)
        false, ($1, $2), Some(m) }
@@ -2019,6 +2019,13 @@ classDefnMember:
            | Some(mWithKwd, members, m) -> Some mWithKwd, Some members, unionRanges (rhs2 parseState 1 4) m
        [ SynMemberDefn.Interface($4, mWithKwd, members, mWhole) ] }
 
+  | opt_attributes opt_access interfaceMember recover
+     { let mInterface = rhs parseState 3
+       if not (isNil $1) then errorR(Error(FSComp.SR.parsAttributesAreNotPermittedOnInterfaceImplementations(), rhs parseState 1))
+       if Option.isSome $2 then errorR(Error(FSComp.SR.parsInterfacesHaveSameVisibilityAsEnclosingType(), mInterface))
+       let ty = SynType.FromParseError(mInterface.EndRange)
+       [ SynMemberDefn.Interface(ty, None, None, rhs2 parseState 1 3) ] }
+
   | opt_attributes opt_access abstractMemberFlags opt_inline nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints classMemberSpfnGetSet opt_ODECLEND
      { let ty, arity = $8
        let isInline, doc, id, explicitValTyparDecls = (Option.isSome $4), grabXmlDoc(parseState, $1, 1), $5, $6

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

@@ -480,6 +480,12 @@ raise (new Exception("exit 1"))
                         EndLine = 5
                         EndColumn = 31 }
               Message = "Expecting member body" }
+            { Error = Error 3113
+              Range = { StartLine = 6
+                        StartColumn = 9
+                        EndLine = 6
+                        EndColumn = 9 }
+              Message = "Unexpected end of input in type definition" }
         ] |> ignore
 
     [<Theory; File "RelaxWhitespace2.fs">]

tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskPerf.fs

@@ -1,6 +1,6 @@
 (*
-msbuild tests\fsharp\perf\tasks\FS\TaskPerf.fsproj /p:Configuration=Release
-dotnet artifacts\bin\TaskPerf\Release\netcoreapp2.1\TaskPerf.dll
+msbuild tests\benchmarks\CompiledCodeBenchmarks\TaskPerf\TaskPerf\TaskPerf.fsproj /p:Configuration=Release
+dotnet artifacts\bin\TaskPerf\Release\net7.0\TaskPerf.dll
 *)
 
 namespace TaskPerf

tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerfCSharp/TaskPerfCSharp.csproj

@@ -1,7 +1,7 @@
 <Project Sdk="Microsoft.NET.Sdk">
 
   <PropertyGroup>
-    <TargetFrameworks>netcoreapp3.1</TargetFrameworks>
+    <TargetFrameworks>net7.0</TargetFrameworks>
     <OutputType>Library</OutputType>
     <LangVersion>8.0</LangVersion>
   </PropertyGroup>

tests/fsharp/typecheck/sigs/neg71.vsbsl

@@ -17,4 +17,6 @@ neg71.fsx(128,5,128,81): parse info FS3520: XML comment is not placed on a valid
 
 neg71.fsx(168,1,168,28): typecheck error FS0960: 'let' and 'do' bindings must come before member and interface definitions in type definitions
 
-neg71.fsx(168,9,168,18): typecheck error FS0039: The value or constructor 'Simulator' is not defined.
+neg71.fsx(104,14,104,14): typecheck error FS0887: The type ''a' is not an interface type
+
+neg71.fsx(104,14,104,14): typecheck error FS0909: All implemented interfaces should be declared on the initial declaration of the type

tests/service/data/SyntaxTree/Member/Inherit 08.fs

@@ -0,0 +1,6 @@
+module Module
+
+type T =
+    inherit as t
+
+    member this.P = 1

tests/service/data/SyntaxTree/Member/Inherit 08.fs.bsl

@@ -0,0 +1,49 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Member/Inherit 08.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
+                    (Unspecified,
+                     [Inherit
+                        (LongIdent (SynLongIdent ([], [], [])), None,
+                         (4,4--4,11));
+                      Member
+                        (SynBinding
+                           (None, Normal, false, false, [],
+                            PreXmlDoc ((4,12), FSharp.Compiler.Xml.XmlDocCollector),
+                            SynValData
+                              (Some { IsInstance = true
+                                      IsDispatchSlot = false
+                                      IsOverrideOrExplicitImpl = false
+                                      IsFinal = false
+                                      GetterOrSetterIsCompilerGenerated = false
+                                      MemberKind = Member },
+                               SynValInfo
+                                 ([[SynArgInfo ([], false, None)]; []],
+                                  SynArgInfo ([], false, None)), None, None),
+                            LongIdent
+                              (SynLongIdent
+                                 ([this; P], [(6,15--6,16)], [None; None]), None,
+                               None, Pats [], None, (6,11--6,17)), None,
+                            Const (Int32 1, (6,20--6,21)), (6,11--6,17),
+                            NoneAtInvisible,
+                            { LeadingKeyword = Member (6,4--6,10)
+                              InlineKeyword = None
+                              EqualsRange = Some (6,18--6,19) }), (4,12--6,21))],
+                     (4,4--6,21)), [], None, (3,5--6,21),
+                  { LeadingKeyword = Type (3,0--3,4)
+                    EqualsRange = Some (3,7--3,8)
+                    WithKeyword = None })], (3,0--6,21))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--6,21), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(4,12)-(4,14) parse error Unexpected keyword 'as' in type definition

tests/service/data/SyntaxTree/Member/Interface 08.fs

@@ -0,0 +1,8 @@
+module Module
+
+type T =
+    interface
+
+    member this.P = 1
+
+()

tests/service/data/SyntaxTree/Member/Interface 08.fs.bsl

@@ -0,0 +1,49 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Member/Interface 08.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
+                    (Unspecified,
+                     [Interface
+                        (FromParseError (4,13--4,13), None, None, (4,4--4,13));
+                      Member
+                        (SynBinding
+                           (None, Normal, false, false, [],
+                            PreXmlDoc ((6,4), FSharp.Compiler.Xml.XmlDocCollector),
+                            SynValData
+                              (Some { IsInstance = true
+                                      IsDispatchSlot = false
+                                      IsOverrideOrExplicitImpl = false
+                                      IsFinal = false
+                                      GetterOrSetterIsCompilerGenerated = false
+                                      MemberKind = Member },
+                               SynValInfo
+                                 ([[SynArgInfo ([], false, None)]; []],
+                                  SynArgInfo ([], false, None)), None, None),
+                            LongIdent
+                              (SynLongIdent
+                                 ([this; P], [(6,15--6,16)], [None; None]), None,
+                               None, Pats [], None, (6,11--6,17)), None,
+                            Const (Int32 1, (6,20--6,21)), (6,11--6,17),
+                            NoneAtInvisible,
+                            { LeadingKeyword = Member (6,4--6,10)
+                              InlineKeyword = None
+                              EqualsRange = Some (6,18--6,19) }), (6,4--6,21))],
+                     (4,4--6,21)), [], None, (3,5--6,21),
+                  { LeadingKeyword = Type (3,0--3,4)
+                    EqualsRange = Some (3,7--3,8)
+                    WithKeyword = None })], (3,0--6,21));
+           Expr (Const (Unit, (8,0--8,2)), (8,0--8,2))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--8,2), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(4,14)-(6,4) parse error Incomplete structured construct at or before this point in member definition

tests/service/data/SyntaxTree/Member/Interface 09.fs

@@ -0,0 +1,8 @@
+module Module
+
+type T =
+    interface
+
+type T2 = int
+
+()