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 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.