From bb8daf3d09ae9636f3975aabb6aaf7540d4fff09 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 29 Jul 2026 15:26:28 +0100 Subject: [PATCH 1/2] Protect varTable and assemblyTable with typeTablesLock for thread safety The var translation tables (varTableFwd/varTableBwd) and assemblyTableFwd have the same check-then-create race as the type tables fixed in #522. Under ParallelCompilation, concurrent quotation translation or assembly resolution can hit the unguarded Dictionary with duplicate Add calls (ArgumentException) or produce duplicate target objects. Wrap convVarToSrc, convVarToTgt, and convProvidedAssembly in the existing typeTablesLock. The lock is already re-entrant (Monitor), so the recursive calls to convTypeToTgt/convTypeToSrc inside these functions are safe. Fixes #525 --- src/ProvidedTypes.fs | 43 +++++++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/src/ProvidedTypes.fs b/src/ProvidedTypes.fs index fa8bbe9..d7ed5ff 100644 --- a/src/ProvidedTypes.fs +++ b/src/ProvidedTypes.fs @@ -9275,13 +9275,13 @@ namespace ProviderImplementation.ProvidedTypes let typeTableFwd = Dictionary() let typeTableBwd = Dictionary() - // Guards the type translation tables above. The F# compiler may translate types on several - // threads at once (e.g. ParallelCompilation, on by default in recent .NET SDKs). The - // check-then-create in convProvidedTypeDefToTgt must be atomic: without this lock, two - // concurrent conversions of the same source ProvidedTypeDefinition each mint a distinct - // target type, and the compiler then fails intermittently with FS0193/FS0001 - // "type X is not compatible with type X" on erased provided types. Monitor is re-entrant, - // so the recursive conversion of declaring/base/argument types on the same thread is fine. + // Guards the translation tables above (type, var, and assembly). The F# compiler may + // translate types on several threads at once (e.g. ParallelCompilation, on by default in + // recent .NET SDKs). The check-then-create in convProvidedTypeDefToTgt, convVarToTgt/Src, + // and convProvidedAssembly must be atomic: without this lock, two concurrent conversions + // of the same source object each mint a distinct target copy, leading to FS0193/FS0001 + // or ArgumentException on duplicate Dictionary keys. Monitor is re-entrant, so recursive + // conversion of declaring/base/argument types on the same thread is fine. let typeTablesLock = obj() let fixName (fullName:string) = @@ -9475,6 +9475,7 @@ namespace ProviderImplementation.ProvidedTypes | Choice2Of2 res -> res and convVarToSrc (v: Var) = + lock typeTablesLock (fun () -> match varTableBwd.TryGetValue v with | true, v -> v | false, _ -> @@ -9482,7 +9483,7 @@ namespace ProviderImplementation.ProvidedTypes // store the original var as we'll have to revert to it later varTableBwd.Add(v, newVar) varTableFwd.Add(newVar, v) - newVar + newVar) and convVarExprToSrc quotation = match quotation with @@ -9491,6 +9492,7 @@ namespace ProviderImplementation.ProvidedTypes | _ -> failwithf "Unexpected non-variable argument: %A" quotation and convVarToTgt (v: Var) = + lock typeTablesLock (fun () -> match varTableFwd.TryGetValue v with | true, v -> v | false, _ -> @@ -9499,7 +9501,7 @@ namespace ProviderImplementation.ProvidedTypes // store it so we reuse it from now on varTableFwd.Add(v, newVar) varTableBwd.Add(newVar, v) - newVar + newVar) and convExprToTgt quotation = @@ -9806,19 +9808,20 @@ namespace ProviderImplementation.ProvidedTypes convMemberDefToTgt declTyT x :?> ProvidedMethod and convProvidedAssembly (assembly: ProvidedAssembly) = - match assemblyTableFwd.TryGetValue(assembly) with - | true, newT -> newT - | false, _ -> - let tgtAssembly = ProvidedAssembly(true, assembly.GetName(), assembly.Location, K(convCustomAttributesDataToTgt(assembly.GetCustomAttributesData()))) + lock typeTablesLock (fun () -> + match assemblyTableFwd.TryGetValue(assembly) with + | true, newT -> newT + | false, _ -> + let tgtAssembly = ProvidedAssembly(true, assembly.GetName(), assembly.Location, K(convCustomAttributesDataToTgt(assembly.GetCustomAttributesData()))) - for (types, enclosingGeneratedTypeNames) in assembly.GetTheTypes() do - let typesT = Array.map convProvidedTypeDefToTgt types - tgtAssembly.AddTheTypes (typesT, enclosingGeneratedTypeNames) + for (types, enclosingGeneratedTypeNames) in assembly.GetTheTypes() do + let typesT = Array.map convProvidedTypeDefToTgt types + tgtAssembly.AddTheTypes (typesT, enclosingGeneratedTypeNames) - assemblyTableFwd.Add(assembly, tgtAssembly) - this.AddSourceAssembly(assembly) - this.AddTargetAssembly(assembly.GetName(), tgtAssembly) - (tgtAssembly :> Assembly) + assemblyTableFwd.Add(assembly, tgtAssembly) + this.AddSourceAssembly(assembly) + this.AddTargetAssembly(assembly.GetName(), tgtAssembly) + (tgtAssembly :> Assembly)) let rec convNamespaceToTgt (x: IProvidedNamespace) = { new IProvidedNamespace with From 51aa795b4eb6496c06c74afef28c5c71390f4d98 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 29 Jul 2026 15:36:42 +0100 Subject: [PATCH 2/2] Add concurrency tests for var/type/assembly table thread safety Three new tests exercise the translation tables under parallel access: 1. Concurrent ConvertSourceExprToTarget on shared Vars - exercises convVarToTgt/convVarToSrc under contention (8 threads, shared Var instances, barrier-synchronized start). 2. Concurrent ConvertSourceTypeToTarget - exercises convType/convTypeRef with various type kinds (generics, arrays, primitives) from 8 threads. 3. Concurrent type translation through ProvidedAssembly - exercises convProvidedAssembly by translating 16 types sharing one ProvidedAssembly from 8 threads simultaneously. Without the locks from #522 and this PR, these tests would fail with ArgumentException (duplicate Dictionary key) or state corruption. --- tests/BasicErasedProvisionTests.fs | 70 ++++++++++++++++++++++++++ tests/BasicGenerativeProvisionTests.fs | 50 ++++++++++++++++++ 2 files changed, 120 insertions(+) diff --git a/tests/BasicErasedProvisionTests.fs b/tests/BasicErasedProvisionTests.fs index 9038d52..85132b2 100644 --- a/tests/BasicErasedProvisionTests.fs +++ b/tests/BasicErasedProvisionTests.fs @@ -5,6 +5,7 @@ open System.Reflection open ProviderImplementation.ProvidedTypes open ProviderImplementation.ProvidedTypesTesting open Microsoft.FSharp.Core.CompilerServices +open Microsoft.FSharp.Quotations open Xunit #nowarn "760" // IDisposable needs new @@ -868,3 +869,72 @@ let ``DefineStaticParameters does not warn when there are no static parameters`` Assert.True(w.IsNone, "No all-optional warning expected for empty parameter list") finally ProvidedTypeDefinition.Logger := prevLogger + +[] +let ``Concurrent ConvertSourceExprToTarget on shared Vars does not corrupt var tables``() = + // Regression test for https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues/525 + // convVarToTgt uses a check-then-create on varTableFwd/varTableBwd. Without locking, + // concurrent translations of the same Var throw ArgumentException (duplicate key) or + // produce inconsistent mappings. + let refs = Targets.DotNetStandard20FSharpRefs() + let cfg = Testing.MakeSimulatedTypeProviderConfig (__SOURCE_DIRECTORY__, refs.[0], refs) + use tp = new TypeProviderForNamespaces(cfg) + let ctxt = tp.TargetContext + + // Build quotation expressions that share the same Var instances. + // Each thread will translate the same expressions, forcing concurrent convVarToTgt calls. + let sharedVar1 = Var("x", typeof) + let sharedVar2 = Var("y", typeof) + let sharedVar3 = Var("z", typeof) + let expr1 = Expr.Lambda(sharedVar1, Expr.Lambda(sharedVar2, Expr.Var(sharedVar1))) + let expr2 = Expr.Let(sharedVar3, Expr.Value(42), Expr.Var(sharedVar3)) + + let errors = System.Collections.Concurrent.ConcurrentBag() + let barrier = new System.Threading.Barrier(8) + let threads = + [| for _ in 1..8 -> + System.Threading.Thread(fun () -> + try + barrier.SignalAndWait() // maximize contention by starting together + for _ in 1..100 do + ctxt.ConvertSourceExprToTarget expr1 |> ignore + ctxt.ConvertSourceExprToTarget expr2 |> ignore + with ex -> + errors.Add(ex)) |] + for th in threads do th.Start() + for th in threads do th.Join() + barrier.Dispose() + Assert.True(errors.IsEmpty, sprintf "Concurrent var-table violations: %A" (errors |> Seq.toList)) + +[] +let ``Concurrent ConvertSourceTypeToTarget does not corrupt type tables``() = + // Regression test: ConvertSourceTypeToTarget uses typeTablesLock (from #522). + // Verify that parallel translation of many types does not throw or produce inconsistent results. + let refs = Targets.DotNetStandard20FSharpRefs() + let cfg = Testing.MakeSimulatedTypeProviderConfig (__SOURCE_DIRECTORY__, refs.[0], refs) + use tp = new TypeProviderForNamespaces(cfg) + let ctxt = tp.TargetContext + + // Use a variety of source types that require translation (including generic and array types + // that exercise deeper paths through convType/convTypeRef) + let sourceTypes = [| typeof; typeof; typeof; typeof; + typeof>; + typeof>; + typeof; typeof> |] + + let errors = System.Collections.Concurrent.ConcurrentBag() + let barrier = new System.Threading.Barrier(8) + let threads = + [| for _ in 1..8 -> + System.Threading.Thread(fun () -> + try + barrier.SignalAndWait() + for _ in 1..50 do + for srcTy in sourceTypes do + ctxt.ConvertSourceTypeToTarget srcTy |> ignore + with ex -> + errors.Add(ex)) |] + for th in threads do th.Start() + for th in threads do th.Join() + barrier.Dispose() + Assert.True(errors.IsEmpty, sprintf "Concurrent type-table violations: %A" (errors |> Seq.toList)) diff --git a/tests/BasicGenerativeProvisionTests.fs b/tests/BasicGenerativeProvisionTests.fs index 7e7f2c9..cc51024 100644 --- a/tests/BasicGenerativeProvisionTests.fs +++ b/tests/BasicGenerativeProvisionTests.fs @@ -555,6 +555,56 @@ let ``TargetTypeDefinition member-wrapper caches are thread-safe under parallel for th in threads do th.Join() Assert.True(errors.IsEmpty, sprintf "Thread-safety violations: %A" (errors |> Seq.toList)) +[] +let ``Concurrent type translation through ProvidedAssembly does not corrupt assemblyTableFwd``() = + // Regression test for https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues/525 + // convProvidedAssembly uses a check-then-create on assemblyTableFwd. Without locking, + // concurrent translations of types in the same ProvidedAssembly can duplicate the assembly + // entry or throw ArgumentException. + // + // Strategy: create a generative type provider with multiple types in one ProvidedAssembly, + // then call ConvertSourceProvidedTypeDefinitionToTarget from many threads simultaneously. + // Each type's translation triggers convProvidedAssembly for the shared assembly. + let runtimeAssemblyRefs = Targets.DotNetStandard20FSharpRefs() + let runtimeAssembly = runtimeAssemblyRefs.[0] + let cfg = Testing.MakeSimulatedTypeProviderConfig(__SOURCE_DIRECTORY__, runtimeAssembly, runtimeAssemblyRefs) + let tp = new TypeProviderForNamespaces(cfg) + let ctxt = tp.TargetContext + + let ns = "ConcurrencyTest.Assembly" + let sharedAssembly = ProvidedAssembly() + + // Create 16 types in the same ProvidedAssembly + let sourceTypes = + [| for i in 1..16 -> + let t = ProvidedTypeDefinition(sharedAssembly, ns, sprintf "Type%d" i, Some typeof, isErased = false) + let ctor = ProvidedConstructor([], invokeCode = fun _ -> <@@ () @@>) + t.AddMember ctor + t |] + + sharedAssembly.AddTypes (sourceTypes |> Array.toList) + tp.AddNamespace(ns, sourceTypes |> Array.toList) + + let errors = System.Collections.Concurrent.ConcurrentBag() + let barrier = new System.Threading.Barrier(8) + let threads = + [| for i in 0..7 -> + System.Threading.Thread(fun () -> + try + barrier.SignalAndWait() + // Each thread translates a different pair of types, but all share the assembly + let t1 = sourceTypes.[i * 2] + let t2 = sourceTypes.[i * 2 + 1] + for _ in 1..20 do + ctxt.ConvertSourceTypeToTarget t1 |> ignore + ctxt.ConvertSourceTypeToTarget t2 |> ignore + with ex -> + errors.Add(ex)) |] + for th in threads do th.Start() + for th in threads do th.Join() + barrier.Dispose() + Assert.True(errors.IsEmpty, sprintf "Concurrent assembly-table violations: %A" (errors |> Seq.toList)) + // Provider for testing that IReadOnlyList values — the format that // real .NET reflection (GetCustomAttributesData()) uses for array-typed constructor arguments — // are correctly unwrapped by transValue in defineCustomAttrs.