Merge branch 'main' into mailbox-disposed

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

@@ -25,5 +25,6 @@
 * Better ranges for CE `use` error reporting. ([PR #17811](https://github.com/dotnet/fsharp/pull/17811))
 * Better ranges for `inherit` error reporting. ([PR #17879](https://github.com/dotnet/fsharp/pull/17879))
 * Better ranges for `inherit` `struct` error reporting. ([PR #17886](https://github.com/dotnet/fsharp/pull/17886))
+* Better ranges for `inherit` objects error reporting. ([PR #17893](https://github.com/dotnet/fsharp/pull/17893))
 
 ### Breaking Changes

eng/Version.Details.xml

@@ -52,25 +52,25 @@
       <Sha>91b9734abbad751d575c002b30778c88d978993c</Sha>
       <SourceBuild RepoName="arcade" ManagedOnly="true" />
     </Dependency>
-    <Dependency Name="optimization.windows_nt-x64.MIBC.Runtime" Version="1.0.0-prerelease.23614.4">
+    <Dependency Name="optimization.windows_nt-x64.MIBC.Runtime" Version="1.0.0-prerelease.24462.2">
       <Uri>https://dev.azure.com/dnceng/internal/_git/dotnet-optimization</Uri>
-      <Sha>15f6d606bfc7cbb65587dd7bc1ec6e9ef283f7e3</Sha>
+      <Sha>9d7532585ce71e30ab55f0364d3cecccaf0775d1</Sha>
     </Dependency>
-    <Dependency Name="optimization.windows_nt-x86.MIBC.Runtime" Version="1.0.0-prerelease.23614.4">
+    <Dependency Name="optimization.windows_nt-x86.MIBC.Runtime" Version="1.0.0-prerelease.24462.2">
       <Uri>https://dev.azure.com/dnceng/internal/_git/dotnet-optimization</Uri>
-      <Sha>15f6d606bfc7cbb65587dd7bc1ec6e9ef283f7e3</Sha>
+      <Sha>9d7532585ce71e30ab55f0364d3cecccaf0775d1</Sha>
     </Dependency>
-    <Dependency Name="optimization.linux-x64.MIBC.Runtime" Version="1.0.0-prerelease.23614.4">
+    <Dependency Name="optimization.linux-x64.MIBC.Runtime" Version="1.0.0-prerelease.24462.2">
       <Uri>https://dev.azure.com/dnceng/internal/_git/dotnet-optimization</Uri>
-      <Sha>15f6d606bfc7cbb65587dd7bc1ec6e9ef283f7e3</Sha>
+      <Sha>9d7532585ce71e30ab55f0364d3cecccaf0775d1</Sha>
     </Dependency>
-    <Dependency Name="optimization.windows_nt-arm64.MIBC.Runtime" Version="1.0.0-prerelease.23614.4">
+    <Dependency Name="optimization.windows_nt-arm64.MIBC.Runtime" Version="1.0.0-prerelease.24462.2">
       <Uri>https://dev.azure.com/dnceng/internal/_git/dotnet-optimization</Uri>
-      <Sha>15f6d606bfc7cbb65587dd7bc1ec6e9ef283f7e3</Sha>
+      <Sha>9d7532585ce71e30ab55f0364d3cecccaf0775d1</Sha>
     </Dependency>
-    <Dependency Name="optimization.linux-arm64.MIBC.Runtime" Version="1.0.0-prerelease.23614.4">
+    <Dependency Name="optimization.linux-arm64.MIBC.Runtime" Version="1.0.0-prerelease.24462.2">
       <Uri>https://dev.azure.com/dnceng/internal/_git/dotnet-optimization</Uri>
-      <Sha>15f6d606bfc7cbb65587dd7bc1ec6e9ef283f7e3</Sha>
+      <Sha>9d7532585ce71e30ab55f0364d3cecccaf0775d1</Sha>
     </Dependency>
   </ToolsetDependencies>
 </Dependencies>

eng/Versions.props

@@ -196,10 +196,10 @@
     <HumanizerCoreVersion>2.2.0</HumanizerCoreVersion>
     <!-- -->
     <!-- MIBC profile packages -->
-    <optimizationwindows_ntx64MIBCRuntimeVersion>1.0.0-prerelease.23614.4</optimizationwindows_ntx64MIBCRuntimeVersion>
-    <optimizationwindows_ntx86MIBCRuntimeVersion>1.0.0-prerelease.23614.4</optimizationwindows_ntx86MIBCRuntimeVersion>
-    <optimizationwindows_ntarm64MIBCRuntimeVersion>1.0.0-prerelease.23614.4</optimizationwindows_ntarm64MIBCRuntimeVersion>
-    <optimizationlinuxx64MIBCRuntimeVersion>1.0.0-prerelease.23614.4</optimizationlinuxx64MIBCRuntimeVersion>
-    <optimizationlinuxarm64MIBCRuntimeVersion>1.0.0-prerelease.23614.4</optimizationlinuxarm64MIBCRuntimeVersion>
+    <optimizationwindows_ntx64MIBCRuntimeVersion>1.0.0-prerelease.24462.2</optimizationwindows_ntx64MIBCRuntimeVersion>
+    <optimizationwindows_ntx86MIBCRuntimeVersion>1.0.0-prerelease.24462.2</optimizationwindows_ntx86MIBCRuntimeVersion>
+    <optimizationwindows_ntarm64MIBCRuntimeVersion>1.0.0-prerelease.24462.2</optimizationwindows_ntarm64MIBCRuntimeVersion>
+    <optimizationlinuxx64MIBCRuntimeVersion>1.0.0-prerelease.24462.2</optimizationlinuxx64MIBCRuntimeVersion>
+    <optimizationlinuxarm64MIBCRuntimeVersion>1.0.0-prerelease.24462.2</optimizationlinuxarm64MIBCRuntimeVersion>
   </PropertyGroup>
 </Project>

src/Compiler/Checking/CheckDeclarations.fs

@@ -1090,7 +1090,7 @@ module MutRecBindingChecking =
 
                             [Phase2AIncrClassCtor (staticCtorInfo, Some incrCtorInfo)], innerState
 
-                        | Some (SynMemberDefn.ImplicitInherit (ty, arg, _baseIdOpt, m)), _ ->
+                        | Some (SynMemberDefn.ImplicitInherit (ty, arg, _baseIdOpt, m, _)), _ ->
                             if tcref.TypeOrMeasureKind = TyparKind.Measure then
                                 error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m))
 
@@ -3324,7 +3324,6 @@ module EstablishTypeDefinitionCores =
                       else None
                   | SynTypeDefnSimpleRepr.General (kind, inherits, slotsigs, fields, isConcrete, _, _, _) ->
                       let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m)
-
                       match inheritedTys with 
                       | [] -> 
                           match kind with 
@@ -3335,21 +3334,25 @@ module EstablishTypeDefinitionCores =
 
                       | [(ty, m)] ->
                           let inheritRange =
-                                match inherits with
-                                | [] -> m
-                                | (synType, _, _) :: _ -> synType.Range
+                              match inherits with
+                              | [] -> m
+                              | (synType, _, _) :: _ -> synType.Range
                           if not firstPass && not (match kind with SynTypeDefnKind.Class -> true | _ -> false) then
                               errorR (Error(FSComp.SR.tcStructsInterfacesEnumsDelegatesMayNotInheritFromOtherTypes(), inheritRange)) 
                           CheckSuperType cenv ty inheritRange 
                           if isTyparTy g ty then 
                               if firstPass then 
                                   errorR(Error(FSComp.SR.tcCannotInheritFromVariableType(), inheritRange)) 
                               Some g.obj_ty_noNulls // a "super" that is a variable type causes grief later
-                          else             
-
+                          else                  
                               Some ty 
-                      | _ -> 
-                          error(Error(FSComp.SR.tcTypesCannotInheritFromMultipleConcreteTypes(), m))
+                      | _ ->
+                          match inherits with
+                          | [] -> ()
+                          | _ :: inherits -> 
+                            for synType, _, _ in inherits do
+                                errorR(Error(FSComp.SR.tcTypesCannotInheritFromMultipleConcreteTypes(), synType.Range))
+                          None
 
                   | SynTypeDefnSimpleRepr.Enum _ -> 
                       Some(g.system_Enum_ty) 
@@ -4278,7 +4281,7 @@ module TcDeclarations =
     //   multiple (binding or slotsig or field or interface or inherit).
     //   i.e. not local-bindings, implicit ctor or implicit inherit (or tycon?).
     //   atMostOne inherit.
-    let private CheckMembersForm ds = 
+    let private CheckMembersForm ds m = 
         match ds with
         | d :: ds when isImplicitCtor d ->
             // Implicit construction 
@@ -4290,7 +4293,7 @@ module TcDeclarations =
             // Skip over 'let' and 'do' bindings
             let _, ds = ds |> List.takeUntil (function SynMemberDefn.LetBindings _ -> false | _ -> true) 
 
-            // Skip over 'let' and 'do' bindings
+            // Skip over member bindings, abstract slots, interfaces and auto properties
             let _, ds = ds |> List.takeUntil (allFalse [isMember;isAbstractSlot;isInterface;isAutoProperty]) 
 
             match ds with
@@ -4299,7 +4302,7 @@ module TcDeclarations =
              | SynMemberDefn.Interface (range=m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have interface", m))
              | SynMemberDefn.ImplicitCtor (range=m) :: _ -> errorR(InternalError("implicit class construction with two implicit constructions", m))
              | SynMemberDefn.AutoProperty (range=m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have auto property", m))
-             | SynMemberDefn.ImplicitInherit (range=m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveOneInherit(), m))
+             | SynMemberDefn.ImplicitInherit _ :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveOneInherit(), m))
              | SynMemberDefn.LetBindings (range=m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveLocalBindingsBeforeMembers(), m))
              | SynMemberDefn.Inherit (trivia= { InheritKeyword = m }) :: _ -> errorR(Error(FSComp.SR.tcInheritDeclarationMissingArguments(), m))
              | SynMemberDefn.NestedType (range=m) :: _ -> errorR(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m))
@@ -4467,14 +4470,14 @@ module TcDeclarations =
         | SynTypeDefnRepr.ObjectModel(kind, members, m) ->
             let members = desugarGetSetMembers members
 
-            CheckMembersForm members
+            CheckMembersForm members synTyconInfo.Range
 
             let fields = members |> List.choose (function SynMemberDefn.ValField (fieldInfo = f) -> Some f | _ -> None)
             let implements2 = members |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None)
             let inherits =
                 members |> List.choose (function 
                     | SynMemberDefn.Inherit (Some ty, idOpt, m, _) -> Some(ty, m, idOpt)
-                    | SynMemberDefn.ImplicitInherit (ty, _, idOpt, m) -> Some(ty, m, idOpt)
+                    | SynMemberDefn.ImplicitInherit (ty, _, idOpt, m, _) -> Some(ty, m, idOpt)
                     | _ -> None)
 
             //let nestedTycons = cspec |> List.choose (function SynMemberDefn.NestedType (x, _, _) -> Some x | _ -> None)

src/Compiler/Driver/GraphChecking/FileContentMapping.fs

@@ -212,7 +212,7 @@ let visitSynMemberDefn (md: SynMemberDefn) : FileContentEntry list =
             yield! collectFromOption visitBinding memberDefnForGet
             yield! collectFromOption visitBinding memberDefnForSet
         | SynMemberDefn.ImplicitCtor(ctorArgs = pat) -> yield! visitPat pat
-        | SynMemberDefn.ImplicitInherit(inheritType, inheritArgs, _, _) ->
+        | SynMemberDefn.ImplicitInherit(inheritType, inheritArgs, _, _, _) ->
             yield! visitSynType inheritType
             yield! visitSynExpr inheritArgs
         | SynMemberDefn.LetBindings(bindings = bindings) -> yield! List.collect visitBinding bindings

src/Compiler/Driver/GraphChecking/GraphProcessing.fs

@@ -252,6 +252,7 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
         let rec queueNode node =
             Async.Start(
                 async {
+                    use! _catch = Async.OnCancel(completionSignal.TrySetCanceled >> ignore)
                     let! res = processNode node |> Async.Catch
 
                     match res with

src/Compiler/Service/FSharpParseFileResults.fs

@@ -817,7 +817,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput,
                         | SynMemberDefn.Inherit(range = m) ->
                             // can break on the "inherit" clause
                             yield! checkRange m
-                        | SynMemberDefn.ImplicitInherit(_, arg, _, m) ->
+                        | SynMemberDefn.ImplicitInherit(_, arg, _, m, _) ->
                             // can break on the "inherit" clause
                             yield! checkRange m
                             yield! walkExpr true arg

src/Compiler/Service/ServiceInterfaceStubGenerator.fs

@@ -825,7 +825,7 @@ module InterfaceStubGenerator =
                 | SynMemberDefn.Open _
                 | SynMemberDefn.ImplicitCtor _
                 | SynMemberDefn.Inherit _ -> None
-                | SynMemberDefn.ImplicitInherit(_, expr, _, _) -> walkExpr expr
+                | SynMemberDefn.ImplicitInherit(_, expr, _, _, _) -> walkExpr expr
 
         and walkBinding (SynBinding(expr = expr)) = walkExpr expr
 

src/Compiler/Service/ServiceParseTreeWalk.fs

@@ -958,7 +958,7 @@ module SyntaxTraversal =
 
             | SynMemberDefn.ImplicitCtor(ctorArgs = pat) -> traverseSynSimplePats path pat
 
-            | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range) ->
+            | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range, _) ->
                 [
                     dive () synType.Range (fun () ->
                         match traverseInherit (synType, range) with

src/Compiler/Service/ServiceParsedInputOps.fs

@@ -905,7 +905,7 @@ module ParsedInput =
             | SynMemberDefn.ImplicitCtor(attributes = Attributes attrs; ctorArgs = pat) ->
                 List.tryPick walkAttribute attrs |> Option.orElseWith (fun _ -> walkPat pat)
 
-            | SynMemberDefn.ImplicitInherit(t, e, _, _) -> walkType t |> Option.orElseWith (fun () -> walkExpr e)
+            | SynMemberDefn.ImplicitInherit(t, e, _, _, _) -> walkType t |> Option.orElseWith (fun () -> walkExpr e)
 
             | SynMemberDefn.LetBindings(bindings, _, _, _) -> List.tryPick walkBinding bindings
 
@@ -2233,7 +2233,7 @@ module ParsedInput =
             | SynMemberDefn.ImplicitCtor(attributes = Attributes attrs; ctorArgs = pat) ->
                 List.iter walkAttribute attrs
                 walkPat pat
-            | SynMemberDefn.ImplicitInherit(t, e, _, _) ->
+            | SynMemberDefn.ImplicitInherit(t, e, _, _, _) ->
                 walkType t
                 walkExpr e
             | SynMemberDefn.LetBindings(bindings, _, _, _) -> List.iter walkBinding bindings

src/Compiler/SyntaxTree/SyntaxTree.fs

@@ -1488,7 +1488,12 @@ type SynMemberDefn =
         range: range *
         trivia: SynMemberDefnImplicitCtorTrivia
 
-    | ImplicitInherit of inheritType: SynType * inheritArgs: SynExpr * inheritAlias: Ident option * range: range
+    | ImplicitInherit of
+        inheritType: SynType *
+        inheritArgs: SynExpr *
+        inheritAlias: Ident option *
+        range: range *
+        trivia: SynMemberDefnInheritTrivia
 
     | LetBindings of bindings: SynBinding list * isStatic: bool * isRecursive: bool * range: range
 

src/Compiler/SyntaxTree/SyntaxTree.fsi

@@ -1654,7 +1654,12 @@ type SynMemberDefn =
         trivia: SynMemberDefnImplicitCtorTrivia
 
     /// An implicit inherit definition, 'inherit <typ>(args...) as base'
-    | ImplicitInherit of inheritType: SynType * inheritArgs: SynExpr * inheritAlias: Ident option * range: range
+    | ImplicitInherit of
+        inheritType: SynType *
+        inheritArgs: SynExpr *
+        inheritAlias: Ident option *
+        range: range *
+        trivia: SynMemberDefnInheritTrivia
 
     /// A 'let' definition within a class
     | LetBindings of bindings: SynBinding list * isStatic: bool * isRecursive: bool * range: range

src/Compiler/pars.fsy

@@ -2328,7 +2328,8 @@ inheritsDefn:
 
   | INHERIT atomTypeNonAtomicDeprecated opt_HIGH_PRECEDENCE_APP atomicExprAfterType optBaseSpec
      { let mDecl = unionRanges (rhs parseState 1) $4.Range
-       SynMemberDefn.ImplicitInherit($2, $4, $5, mDecl) }
+       let trivia = { InheritKeyword = rhs parseState 1 }
+       SynMemberDefn.ImplicitInherit($2, $4, $5, mDecl, trivia) }
 
   | INHERIT ends_coming_soon_or_recover
      { let mDecl = (rhs parseState 1)

tests/FSharp.Compiler.ComponentTests/ErrorMessages/ClassesTests.fs

@@ -861,4 +861,83 @@ type C5 = class inherit System.MulticastDelegate override x.ToString() = ""  end
             (Error 771, Line 4, Col 25, Line 4, Col 36, "The types System.ValueType, System.Enum, System.Delegate, System.MulticastDelegate and System.Array cannot be used as super types in an object expression or class")
             (Error 771, Line 5, Col 25, Line 5, Col 40, "The types System.ValueType, System.Enum, System.Delegate, System.MulticastDelegate and System.Array cannot be used as super types in an object expression or class");
             (Error 771, Line 6, Col 25, Line 6, Col 49, "The types System.ValueType, System.Enum, System.Delegate, System.MulticastDelegate and System.Array cannot be used as super types in an object expression or class")
+        ]
+
+
+    [<Fact>]
+    let ``Types can inherit from a single concrete type`` () =
+        Fsx """
+type ClassA() = class end
+
+type Class() =
+    inherit ClassA()
+        """
+        |> typecheck
+        |> shouldSucceed
+
+    [<Fact>]
+    let ``Types cannot inherit from multiple concrete types.`` () =
+        Fsx """
+type ClassA() = class end
+
+type ClassB() = class end
+
+type ClassC() = class end
+
+type Class() =
+    inherit ClassA()
+    inherit ClassB()
+    inherit ClassC()
+        """
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 959, Line 8, Col 6, Line 8, Col 11, "Type definitions may only have one 'inherit' specification and it must be the first declaration")
+            (Error 932, Line 10, Col 13, Line 10, Col 19, "Types cannot inherit from multiple concrete types")
+            (Error 932, Line 11, Col 13, Line 11, Col 19, "Types cannot inherit from multiple concrete types")
+        ]
+
+    [<Fact>]
+    let ``Types cannot inherit from multiple concrete types. Type name cannot be empty.`` () =
+        Fsx """
+type IA = interface end
+
+type I =
+    inherit IA
+    inherit
+        """
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 3159, Line 6, Col 5, Line 6, Col 12, "Type name cannot be empty.")
+        ]
+
+    [<Fact>]
+    let ``Inheriting multiple base interfaces`` () =
+        Fsx """
+type IA = interface end
+type IB = interface end
+
+type I =
+    inherit IA
+    inherit IB
+        """
+        |> typecheck
+        |> shouldSucceed
+
+    [<Fact>]
+    let ``Class inheriting multiple base interfaces`` () =
+        Fsx """
+type IA = interface end
+type IB = interface end
+
+type I() =
+    inherit IA
+    inherit IB
+        """
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 961, Line 6, Col 5, Line 6, Col 12, "This 'inherit' declaration specifies the inherited type but no arguments. Consider supplying arguments, e.g. 'inherit BaseType(args)'.")
+            (Error 932, Line 7, Col 13, Line 7, Col 15, "Types cannot inherit from multiple concrete types")
         ]