Merge main to release/net8

src/Compiler/Checking/CheckDeclarations.fs

@@ -914,7 +914,10 @@ module MutRecBindingChecking =
                             // Phase2A: let-bindings - pass through 
                             let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev)     
                             [Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m)], innerState
-
+
+                        | SynMemberDefn.Member(SynBinding(headPat = SynPat.FromParseError(SynPat.Wild _, _)), _), _ ->
+                            [], innerState
+
                         | SynMemberDefn.Member (bind, m), _ ->
                             // Phase2A: member binding - create prelim valspec (for recursive reference) and RecursiveBindingInfo 
                             let NormalizedBinding(_, _, _, _, _, _, _, valSynData, _, _, _, _) as bind = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv envForTycon bind
@@ -4882,6 +4885,9 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
       | SynModuleDecl.HashDirective _ -> 
           return ([], [], []), env, env
 
+      | SynModuleDecl.NestedModule(moduleInfo = (SynComponentInfo(longId = []))) ->
+          return ([], [], []), env, env
+
       | SynModuleDecl.NestedModule(compInfo, isRec, moduleDefs, isContinuingModule, m, trivia) ->
 
           // Treat 'module rec M = ...' as a single mutually recursive definition group 'module M = ...'
@@ -4976,9 +4982,12 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
           // to 
           //    namespace [rec] A.B
           //      module M = ...
-          let enclosingNamespacePath, defs = 
-              if kind.IsModule then 
-                  let nsp, modName = List.frontAndBack longId
+          let enclosingNamespacePath, defs =
+              if kind.IsModule then
+                  let nsp, modName =
+                      match longId with
+                      | [] -> [], mkSynId m.EndRange ""
+                      | _ -> List.frontAndBack longId
                   let modDecl = [SynModuleDecl.NestedModule(SynComponentInfo(attribs, None, [], [modName], xml, false, vis, m), false, defs, true, m, SynModuleDeclNestedModuleTrivia.Zero)] 
                   nsp, modDecl
               else 
@@ -5079,6 +5088,9 @@ and TcModuleOrNamespaceElementsMutRec (cenv: cenv) parent typeNames m envInitial
                           else List.map (List.singleton >> MutRecShape.Lets) binds
                   binds, (false, false, attrs)
 
+              | SynModuleDecl.NestedModule(moduleInfo = (SynComponentInfo(longId = []))) ->
+                  [], (openOk, moduleAbbrevOk, attrs)
+
               | SynModuleDecl.NestedModule(moduleInfo=compInfo; isRecursive=isRec; decls=synDefs; range=moduleRange) -> 
                   if isRec then warning(Error(FSComp.SR.tcRecImplied(), compInfo.Range))
                   let mutRecDefs, (_, _, attrs) = loop false moduleRange attrs synDefs 

src/Compiler/Checking/CheckExpressions.fs

@@ -4353,8 +4353,9 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn
     | SynType.Tuple(isStruct, segments, m) ->
         TcTupleType kindOpt cenv newOk checkConstraints occ env tpenv isStruct segments m
 
-    | SynType.AnonRecd(_, [],m) ->
-        error(Error((FSComp.SR.tcAnonymousTypeInvalidInDeclaration()), m))
+    | SynType.AnonRecd(fields = []) ->
+        // The parser takes care of error messages
+        NewErrorType(), tpenv
 
     | SynType.AnonRecd(isStruct, args, m) ->
         TcAnonRecdType cenv newOk checkConstraints occ env tpenv isStruct args m

src/Compiler/Service/ServiceLexing.fs

@@ -173,11 +173,7 @@ module internal TokenClassifications =
         match token with
         | HASH_IDENT s
         | IDENT s ->
-            if s.Length <= 0 then
-                System.Diagnostics.Debug.Assert(false, "BUG: Received zero length IDENT token.")
-                // This is related to 4783. Recover by treating as lower case identifier.
-                (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None)
-            else if Char.ToUpperInvariant s[0] = s[0] then
+            if s.Length > 0 && Char.ToUpperInvariant s[0] = s[0] then
                 (FSharpTokenColorKind.UpperIdentifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None)
             else
                 (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None)

tests/FSharp.Compiler.ComponentTests/Conformance/Types/RecordTypes/AnonymousRecords.fs

@@ -42,4 +42,26 @@ module AnonRecd =
 """
         |> compile
         |> shouldFail
-        |> withErrorCode 3523
+        |> withErrorCode 3523
+
+    [<Fact>]
+    let ``Anonymous record types with parser errors or no fields do not produce overlapping diagnostics`` () =
+        FSharp """
+module AnonRecd
+
+type ContactMethod =
+    | Address of {| Line1 : string; Line 2 : string; Postcode : string |}
+
+let (x: {| |}) = ()
+
+type ErrorResponse =
+    { error: {| type : string
+                message : string |} }
+"""
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            Error 10, Line 5, Col 42, Line 5, Col 43, "Unexpected integer literal in field declaration. Expected ':' or other token."
+            Error 10, Line 7, Col 12, Line 7, Col 14, "Unexpected symbol '|}' in field declaration. Expected identifier or other token."
+            Error 10, Line 10, Col 17, Line 10, Col 21, "Incomplete structured construct at or before this point in field declaration. Expected identifier or other token."
+        ]

tests/FSharp.Test.Utilities/CompilerAssert.fs

@@ -336,6 +336,9 @@ module rec CompilerAssertHelpers =
             Stamp = None
         }
 
+    let defaultProjectOptionsForFilePath path (targetFramework: TargetFramework) =
+        { defaultProjectOptions targetFramework with SourceFiles = [| path |] }
+
     let rawCompile outputFilePath isExe options (targetFramework: TargetFramework) (sources: SourceCodeFileKind list) =
         let args =
             [|
@@ -804,7 +807,7 @@ Updated automatically, please check diffs in your pull request, changes must be
     /// Parses and type checks the given source. Fails if type checker is aborted.
     static member ParseAndTypeCheck(options, name, source: string) =
         let parseResults, fileAnswer =
-            let defaultOptions = defaultProjectOptions TargetFramework.Current
+            let defaultOptions = defaultProjectOptionsForFilePath name TargetFramework.Current
             checker.ParseAndCheckFileInProject(
                 name,
                 0,

tests/service/SyntaxTreeTests.fs

@@ -6,6 +6,7 @@ open FSharp.Compiler.Diagnostics
 open FSharp.Compiler.Service.Tests.Common
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
+open FSharp.Test
 open NUnit.Framework
 
 let testCasesDir = Path.Combine(__SOURCE_DIRECTORY__, "data", "SyntaxTree")
@@ -197,3 +198,6 @@ let ParseFile fileName =
         File.Delete(actualPath)
 
     Assert.AreEqual(expected, actual)
+
+    // Run type checker to assert that it doesn't fail with the tree produced by the parser
+    CompilerAssert.ParseAndTypeCheck([|"--langversion:preview"|], fileName, contents) |> ignore

tests/service/TokenizerTests.fs

@@ -9,7 +9,7 @@ module FSharp.Compiler.Service.Tests.TokenizerTests
 #endif
 
 open FSharp.Compiler.Tokenization
-
+open FsUnit
 open NUnit.Framework
 
 let sourceTok = FSharpSourceTokenizer([], Some "C:\\test.fsx", None)
@@ -214,3 +214,22 @@ let ``Tokenizer test - single-line nested string interpolation``() =
         printfn "expected = %A" expected
         Assert.Fail(sprintf "actual and expected did not match,actual =\n%A\nexpected=\n%A\n" actual expected)
 
+
+[<Test>]
+let ``Unfinished idents``() =
+    let tokenizedLines =
+      tokenizeLines
+        [| "`"; "``"; "``a"; "``a`"; "```" |]
+
+    let actual =
+        [ for lineTokens in tokenizedLines |> List.map snd do
+            [ for str, info in lineTokens -> info.TokenName, str ] ]
+
+    let expected =
+        [["IDENT", "`"]
+         ["IDENT", "``"]
+         ["IDENT", "``a"]
+         ["IDENT", "``a`"]
+         ["IDENT", "```"]]
+
+    actual |> shouldEqual expected

tests/service/data/SyntaxTree/Expression/Id 01.fs

@@ -0,0 +1,3 @@
+module Module
+
+a

tests/service/data/SyntaxTree/Expression/Id 01.fs.bsl

@@ -0,0 +1,9 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Expression/Id 01.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule, [Expr (Ident a, (3,0--3,1))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--3,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))

tests/service/data/SyntaxTree/Expression/Id 02.fs

@@ -0,0 +1,4 @@
+module Module
+
+``a
+b

tests/service/data/SyntaxTree/Expression/Id 02.fs.bsl

@@ -0,0 +1,12 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Expression/Id 02.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Expr (Ident a, (3,0--3,3)); Expr (Ident b, (4,0--4,1))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--4,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,0)-(3,3) parse error This is not a valid identifier

tests/service/data/SyntaxTree/Expression/Id 03.fs

@@ -0,0 +1,4 @@
+module Module
+
+``
+b

tests/service/data/SyntaxTree/Expression/Id 03.fs.bsl

@@ -0,0 +1,13 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Expression/Id 03.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Expr (FromParseError (Ident , (3,0--3,2)), (3,0--3,2));
+           Expr (Ident b, (4,0--4,1))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--4,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,0)-(3,2) parse error This is not a valid identifier

tests/service/data/SyntaxTree/Expression/Id 04.fs

@@ -0,0 +1,4 @@
+module Module
+
+`
+b

tests/service/data/SyntaxTree/Expression/Id 04.fs.bsl

@@ -0,0 +1,13 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Expression/Id 04.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Expr (FromParseError (Ident , (3,0--3,1)), (3,0--3,1));
+           Expr (Ident b, (4,0--4,1))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--4,1), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,0)-(3,1) parse error This is not a valid identifier

tests/service/data/SyntaxTree/Expression/Id 05.fs

@@ -0,0 +1,3 @@
+module Module
+
+`b

tests/service/data/SyntaxTree/Expression/Id 05.fs.bsl

@@ -0,0 +1,15 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Expression/Id 05.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Expr
+             (App
+                (NonAtomic, false, FromParseError (Ident , (3,0--3,1)), Ident b,
+                 (3,0--3,2)), (3,0--3,2))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--3,2), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(3,0)-(3,1) parse error This is not a valid identifier

tests/service/data/SyntaxTree/Expression/Id 06.fs

@@ -0,0 +1 @@
+``

tests/service/data/SyntaxTree/Expression/Id 06.fs.bsl

@@ -0,0 +1,12 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Expression/Id 06.fs", false, QualifiedNameOfFile Id 06, [], [],
+      [SynModuleOrNamespace
+         ([Id 06], false, AnonModule,
+          [Expr (FromParseError (Ident , (1,0--1,2)), (1,0--1,2))],
+          PreXmlDocEmpty, [], None, (1,0--1,2), { LeadingKeyword = None })],
+      (true, true), { ConditionalDirectives = []
+                      CodeComments = [] }, set []))
+
+(1,0)-(1,2) parse error This is not a valid identifier
+(1,0)-(1,2) parse warning The declarations in this file will be placed in an implicit module 'Id 06' based on the file name 'Id 06.fs'. However this is not a valid F# identifier, so the contents will not be accessible from other files. Consider renaming the file or adding a 'module' or 'namespace' declaration at the top of the file.

tests/service/data/SyntaxTree/Expression/Id 07.fs

@@ -0,0 +1 @@
+`

tests/service/data/SyntaxTree/Expression/Id 07.fs.bsl

@@ -0,0 +1,12 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Expression/Id 07.fs", false, QualifiedNameOfFile Id 07, [], [],
+      [SynModuleOrNamespace
+         ([Id 07], false, AnonModule,
+          [Expr (FromParseError (Ident , (1,0--1,1)), (1,0--1,1))],
+          PreXmlDocEmpty, [], None, (1,0--1,1), { LeadingKeyword = None })],
+      (true, true), { ConditionalDirectives = []
+                      CodeComments = [] }, set []))
+
+(1,0)-(1,1) parse error This is not a valid identifier
+(1,0)-(1,1) parse warning The declarations in this file will be placed in an implicit module 'Id 07' based on the file name 'Id 07.fs'. However this is not a valid F# identifier, so the contents will not be accessible from other files. Consider renaming the file or adding a 'module' or 'namespace' declaration at the top of the file.

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

@@ -0,0 +1,6 @@
+module Module
+
+type U =
+    | A
+
+    member

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

@@ -0,0 +1,48 @@
+ImplFile
+  (ParsedImplFileInput
+     ("/root/Member/Member 09.fs", false, QualifiedNameOfFile Module, [], [],
+      [SynModuleOrNamespace
+         ([Module], false, NamedModule,
+          [Types
+             ([SynTypeDefn
+                 (SynComponentInfo
+                    ([], None, [], [U],
+                     PreXmlDoc ((3,0), FSharp.Compiler.Xml.XmlDocCollector),
+                     false, None, (3,5--3,6)),
+                  Simple
+                    (Union
+                       (None,
+                        [SynUnionCase
+                           ([], SynIdent (A, None), Fields [],
+                            PreXmlDoc ((4,4), FSharp.Compiler.Xml.XmlDocCollector),
+                            None, (4,6--4,7), { BarRange = Some (4,4--4,5) })],
+                        (4,4--4,7)), (4,4--4,7)),
+                  [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),
+                         FromParseError (Wild (6,10--6,10), (6,10--6,10)), None,
+                         ArbitraryAfterError ("classDefnMember1", (6,10--6,10)),
+                         (6,4--6,10), NoneAtInvisible,
+                         { LeadingKeyword = Member (6,4--6,10)
+                           InlineKeyword = None
+                           EqualsRange = None }), (6,4--6,10))], None,
+                  (3,5--6,10), { LeadingKeyword = Type (3,0--3,4)
+                                 EqualsRange = Some (3,7--3,8)
+                                 WithKeyword = None })], (3,0--6,10))],
+          PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), [], None,
+          (1,0--6,10), { LeadingKeyword = Module (1,0--1,6) })], (true, true),
+      { ConditionalDirectives = []
+        CodeComments = [] }, set []))
+
+(7,0)-(7,0) parse error Incomplete structured construct at or before this point in member definition