Fix spurious type errors for provided types under parallel compilation

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

@@ -1,5 +1,7 @@
 ### Fixed
 
+* Provided types used from multiple files no longer produce spurious FS0001 type mismatches under parallel compilation; provided-type entities are now interned so every file linking a given provided type shares one entity. ([PR #19969](https://github.com/dotnet/fsharp/pull/19969))
+* TypeProviders-SDK providers now load under an unoptimized compiler; the `systemRuntimeContainsType` closure field the SDK reflects on (`tcImports`) is captured stably regardless of optimization settings. ([PR #19969](https://github.com/dotnet/fsharp/pull/19969))
 * Tooltip "Full name" now shows demangled companion module names (e.g. `MyType.func` instead of `MyTypeModule.func`). ([Issue #17335](https://github.com/dotnet/fsharp/issues/17335), [PR #19867](https://github.com/dotnet/fsharp/pull/19867))
 * Fix internal error (FS0193) when calling an indexed property setter with a named argument that matches an indexer parameter. ([Issue #16034](https://github.com/dotnet/fsharp/issues/16034), [PR #19851](https://github.com/dotnet/fsharp/pull/19851))
 * Fix missing FS1182 ("unused binding") warning for unused `let` function bindings inside class types. ([Issue #13849](https://github.com/dotnet/fsharp/issues/13849), [PR #19805](https://github.com/dotnet/fsharp/pull/19805))

src/Compiler/Checking/NameResolution.fs

@@ -1004,8 +1004,11 @@ let CheckForDirectReferenceToGeneratedType (tcref: TyconRef, genOk, m) =
 let AddEntityForProvidedType (amap: Import.ImportMap, modref: ModuleOrNamespaceRef, resolutionEnvironment, st: Tainted<ProvidedType>, m) =
     let importProvidedType t = Import.ImportProvidedType amap m t
     let isSuppressRelocate = amap.g.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate), m)
-    let tycon = Construct.NewProvidedTycon(resolutionEnvironment, st, importProvidedType, isSuppressRelocate, m)
-    modref.ModuleOrNamespaceType.AddProvidedTypeEntity tycon
+    let providedTypeName = st.PUntaint((fun st -> st.Name), m)
+    let tycon =
+        modref.ModuleOrNamespaceType.GetOrInternProvidedEntity(
+            providedTypeName,
+            (fun () -> Construct.NewProvidedTycon(resolutionEnvironment, st, importProvidedType, isSuppressRelocate, m)))
     let tcref = modref.NestedTyconRef tycon
     System.Diagnostics.Debug.Assert(modref.TryDeref.IsSome)
     tcref

src/Compiler/Driver/CompilerImports.fs

@@ -1572,7 +1572,11 @@ and [<Sealed>] TcImports
     member _.ProviderGeneratedTypeRoots =
         tciLock.AcquireLock(fun tcitok ->
             RequireTcImportsLock(tcitok, generatedTypeRoots)
-            generatedTypeRoots.Values |> Seq.sortBy fst |> Seq.map snd |> Seq.toList)
+            // Sort by qualified name so the emitted set is deterministic regardless of parallel insertion order.
+            generatedTypeRoots.Values
+            |> Seq.map snd
+            |> Seq.sortBy (fun (ProviderGeneratedType(_, ilTyRef, _)) -> ilTyRef.QualifiedName)
+            |> Seq.toList)
 #endif
 
     member private tcImports.AttachDisposeAction action =
@@ -1796,10 +1800,13 @@ and [<Sealed>] TcImports
                 let isSuppressRelocate =
                     tcConfig.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate), m)
 
-                let newEntity =
-                    Construct.NewProvidedTycon(typeProviderEnvironment, st, importProvidedType, isSuppressRelocate, m)
+                let providedTypeName = st.PUntaint((fun st -> st.Name), m)
 
-                entity.ModuleOrNamespaceType.AddProvidedTypeEntity newEntity
+                entity.ModuleOrNamespaceType.GetOrInternProvidedEntity(
+                    providedTypeName,
+                    (fun () -> Construct.NewProvidedTycon(typeProviderEnvironment, st, importProvidedType, isSuppressRelocate, m))
+                )
+                |> ignore
             | None -> ()
 
             entity.entity_tycon_repr <-
@@ -1860,14 +1867,17 @@ and [<Sealed>] TcImports
                 let name = AssemblyName.GetAssemblyName(resolution.resolvedPath)
                 !!name.Version
 
-            // Note, this only captures systemRuntimeContainsTypeRef (which captures tcImportsWeak, using name tcImports)
             let systemRuntimeContainsType =
                 let tcImports = tcImportsWeak
 
-                // The name of this captured value must not change, see comments on TcImportsWeakFacade above
-                assert (nameof tcImports = "tcImports")
-
-                let mutable systemRuntimeContainsTypeRef = tcImports.SystemRuntimeContainsType
+                // The TypeProvider SDK reflects over this closure and requires a captured field literally
+                // named `tcImports` (see comments on TcImportsWeakFacade above). Capture it through an
+                // explicit lambda rather than passing the method group `tcImports.SystemRuntimeContainsType`:
+                // a method-group value names its captured receiver an optimization-dependent synthesized
+                // name (e.g. `objectArg` under Debug/--optimize-), which breaks the SDK. An explicit lambda
+                // captures the local under its own name `tcImports` in every configuration.
+                let mutable systemRuntimeContainsTypeRef =
+                    fun typeName -> tcImports.SystemRuntimeContainsType typeName
 
                 // When the tcImports is disposed the systemRuntimeContainsTypeRef thunk is replaced
                 // with one raising an exception.

src/Compiler/TypedTree/TypeProviders.fs

@@ -1443,9 +1443,10 @@ type ProviderGeneratedType = ProviderGeneratedType of ilOrigTyRef: ILTypeRef * i
 /// The table of information recording remappings from type names in the provided assembly to type
 /// names in the statically linked, embedded assembly, plus what types are nested in side what types.
 type ProvidedAssemblyStaticLinkingMap = 
-    { ILTypeMap: Dictionary<ILTypeRef, ILTypeRef> }
+    // graph-based checking can embed generated types from one provider assembly in parallel
+    { ILTypeMap: ConcurrentDictionary<ILTypeRef, ILTypeRef> }
     static member CreateNew() = 
-        { ILTypeMap = Dictionary() }
+        { ILTypeMap = ConcurrentDictionary() }
 
 /// Check if this is a direct reference to a non-embedded generated type. This is not permitted at any name resolution.
 /// We check by seeing if the type is absent from the remapping context.

src/Compiler/TypedTree/TypeProviders.fsi

@@ -485,7 +485,7 @@ type ProvidedAssemblyStaticLinkingMap =
     {
         /// The table of remappings from type names in the provided assembly to type
         /// names in the statically linked, embedded assembly.
-        ILTypeMap: Dictionary<ILTypeRef, ILTypeRef>
+        ILTypeMap: ConcurrentDictionary<ILTypeRef, ILTypeRef>
     }
 
     /// Create a new static linking map, ready to populate with data.

src/Compiler/TypedTree/TypedTree.fs

@@ -5,6 +5,7 @@ module internal rec FSharp.Compiler.TypedTree
 
 open System
 open System.Collections.Generic
+open System.Collections.Concurrent
 open System.Collections.Immutable
 open System.Diagnostics
 open Internal.Utilities.Collections
@@ -2009,6 +2010,11 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList<Val>, en
 
     /// Mutation used during compilation of FSharp.Core.dll
     let mutable entities = entities 
+
+#if !NO_TYPEPROVIDERS
+    // One Entity per provided type even when linked concurrently from several files (graph-based checking).
+    let mutable providedEntitiesByMangledName: ConcurrentDictionary<string, Lazy<Entity>> | null = null
+#endif
 
     // Lookup tables keyed the way various clients expect them to be keyed.
     // We attach them here so we don't need to store lookup tables via any other technique.
@@ -2056,11 +2062,28 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList<Val>, en
 #if !NO_TYPEPROVIDERS
     /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace
     member mtyp.AddProvidedTypeEntity(entity: Entity) = 
-        entities <- QueueList.appendOne entities entity
+        let rec append () =
+            let current = entities
+            let updated = QueueList.appendOne current entity
+            if not (obj.ReferenceEquals(System.Threading.Interlocked.CompareExchange(&entities, updated, current), current)) then
+                append ()
+        append ()
         tyconsByMangledNameCache <- None          
         tyconsByDemangledNameAndArityCache <- None
         tyconsByAccessNamesCache <- None
         allEntitiesByMangledNameCache <- None             
+
+    /// Interns a provided-type entity by mangled name; callers must use the returned entity.
+    member mtyp.GetOrInternProvidedEntity(mangledName: string, create: unit -> Entity) : Entity =
+        let table =
+            match providedEntitiesByMangledName with
+            | null ->
+                let created = ConcurrentDictionary<string, Lazy<Entity>>()
+                match System.Threading.Interlocked.CompareExchange(&providedEntitiesByMangledName, created, null) with
+                | null -> created
+                | existing -> existing
+            | existing -> existing
+        table.GetOrAdd(mangledName, fun _ -> lazy (let entity = create () in mtyp.AddProvidedTypeEntity entity; entity)).Value
 #endif 
 
     /// Return a new module or namespace type with an entity added.
@@ -3505,10 +3528,12 @@ type NonLocalEntityRef =
                 match st.PApply((fun st -> st.GetNestedType path[i]), m) with
                 | Tainted.Null -> ValueNone
                 | Tainted.NonNull st -> 
-                    let newEntity = Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m)
-                    parentEntity.ModuleOrNamespaceType.AddProvidedTypeEntity newEntity
-                    if i = path.Length-1 then ValueSome newEntity
-                    else tryResolveNestedTypeOf(newEntity, resolutionEnvironment, st, i+1)
+                    let canonicalEntity =
+                        parentEntity.ModuleOrNamespaceType.GetOrInternProvidedEntity(
+                            path[i],
+                            (fun () -> Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m)))
+                    if i = path.Length-1 then ValueSome canonicalEntity
+                    else tryResolveNestedTypeOf(canonicalEntity, resolutionEnvironment, st, i+1)
 
             tryResolveNestedTypeOf(entity, resolutionEnvironment, st, i)
 
@@ -3551,9 +3576,9 @@ type NonLocalEntityRef =
                     // Note: this is similar to code in CompileOps.fs
                     let rec injectNamespacesFromIToJ (entity: Entity) k = 
                         if k = j then 
-                            let newEntity = Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m)
-                            entity.ModuleOrNamespaceType.AddProvidedTypeEntity newEntity
-                            newEntity
+                            entity.ModuleOrNamespaceType.GetOrInternProvidedEntity(
+                                path[j],
+                                (fun () -> Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m)))
                         else
                             let cpath = entity.CompilationPath.NestedCompPath entity.LogicalName (ModuleOrNamespaceKind.Namespace false)
                             let newEntity = 

src/Compiler/TypedTree/TypedTree.fsi

@@ -1383,6 +1383,10 @@ type ModuleOrNamespaceType =
 #if !NO_TYPEPROVIDERS
     /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace
     member AddProvidedTypeEntity: entity: Entity -> unit
+
+    /// Interns a provided-type entity by mangled name so concurrent linking from multiple files yields one
+    /// Entity. The first caller's 'create' wins; callers must use the returned entity.
+    member GetOrInternProvidedEntity: mangledName: string * create: (unit -> Entity) -> Entity
 #endif
 
     /// Return a new module or namespace type with a value added.

tests/FSharp.Compiler.Service.Tests/ManglingNameOfProvidedTypes.fs

@@ -4,6 +4,14 @@ namespace FSharp.Compiler.Service.Tests
 open Xunit
 open FSharp.Test
 open FSharp.Compiler.Syntax
+open System.Reflection
+open Internal.Utilities.Library.Extras
+open FSharp.Compiler.AbstractIL.IL
+open FSharp.Compiler.SyntaxTreeOps
+open FSharp.Compiler.Text
+open FSharp.Compiler.Xml
+open FSharp.Compiler.TypedTree
+open FSharp.Compiler.TypedTreeBasics
 
 type ManglingNamesOfProvidedTypesWithSingleParameter() = 
 
@@ -66,3 +74,76 @@ type ManglingNamesOfProvidedTypesWithMultipleParameter() =
         let parameters = smashtogether parameters
         let expected = smashtogether [| "Foo", "xyz"; "Foo2", "abc" |]
         Assert.shouldBe expected parameters
+
+/// Regression tests for the loose reflection contract between the compiler and the TypeProvider SDK,
+/// and for concurrent linking of provided types under graph-based parallel checking.
+module ProvidedTypeHostingTests =
+
+    /// The TypeProvider SDK reflects over the value the compiler stores in
+    /// TypeProviderConfig.systemRuntimeContainsType and requires a captured field literally named
+    /// 'tcImports' (https://github.com/fsprojects/FSharp.TypeProviders.SDK ProvidedTypes.fs). That field
+    /// name comes from a closure capture, which is codegen-sensitive: an unoptimized build once emitted it
+    /// as 'objectArg'. Guard the contract here so it cannot silently break per configuration again.
+    [<Fact>]
+    let ``systemRuntimeContainsType closure exposes a field named tcImports`` () =
+        let asm = typeof<FSharp.Compiler.CodeAnalysis.FSharpChecker>.Assembly
+
+        let types =
+            try
+                asm.GetTypes()
+            with :? ReflectionTypeLoadException as ex ->
+                ex.Types |> Array.filter (isNull >> not)
+
+        let flags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic
+
+        let closures =
+            types |> Array.filter (fun t -> not (isNull t) && t.Name.Contains "systemRuntimeContainsType")
+
+        let fieldsByClosure =
+            [ for t in closures -> t.Name, [ for f in t.GetFields flags -> f.Name ] ]
+
+        let exposesTcImports =
+            fieldsByClosure |> List.exists (fun (_, fields) -> List.contains "tcImports" fields)
+
+        Assert.True(
+            exposesTcImports,
+            $"No 'systemRuntimeContainsType' closure exposes a 'tcImports' field. Found: %A{fieldsByClosure}")
+
+    /// Under graph-based parallel checking the same provided type can be linked from several files at once.
+    /// GetOrInternProvidedEntity must yield one canonical Entity (compared by object identity elsewhere) and
+    /// run the side-effecting 'create' exactly once, regardless of how many threads race on the same name.
+    [<Fact>]
+    let ``GetOrInternProvidedEntity yields one entity and creates once under concurrency`` () =
+        let mtyp = Construct.NewEmptyModuleOrNamespaceType(Namespace true)
+        let cpath = CompPath(ILScopeRef.Local, SyntaxAccess.Unknown, [])
+        let createCount = ref 0
+
+        let create () =
+            System.Threading.Interlocked.Increment createCount |> ignore
+
+            Construct.NewModuleOrNamespace
+                (Some cpath)
+                taccessPublic
+                (ident ("MyProvidedType", Range.range0))
+                XmlDoc.Empty
+                []
+                (MaybeLazy.Strict(Construct.NewEmptyModuleOrNamespaceType(Namespace true)))
+
+        let threadCount = 64
+        use barrier = new System.Threading.Barrier(threadCount)
+        let results = System.Collections.Concurrent.ConcurrentBag<Entity>()
+
+        let threads =
+            [ for _ in 1..threadCount ->
+                  System.Threading.Thread(fun () ->
+                      barrier.SignalAndWait()
+                      results.Add(mtyp.GetOrInternProvidedEntity("MyProvidedType", create))) ]
+
+        threads |> List.iter (fun t -> t.Start())
+        threads |> List.iter (fun t -> t.Join())
+
+        let entities = results.ToArray()
+        let canonical = entities[0]
+        Assert.All(entities, (fun e -> Assert.Same(canonical, e)))
+        Assert.Equal(1, createCount.Value)
+        Assert.Equal(1, mtyp.AllEntities |> Seq.length)