Protect varTable and assemblyTable with typeTablesLock for thread safety (#525)

src/ProvidedTypes.fs

@@ -9275,13 +9275,13 @@ namespace ProviderImplementation.ProvidedTypes
         let typeTableFwd = Dictionary<Type, Type>()
         let typeTableBwd = Dictionary<Type, Type>()
 
-        // 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,14 +9475,15 @@ namespace ProviderImplementation.ProvidedTypes
             | Choice2Of2 res -> res
 
         and convVarToSrc (v: Var) =
+          lock typeTablesLock (fun () ->
             match varTableBwd.TryGetValue v with
             | true, v -> v
             | false, _ ->
                 let newVar = Var (v.Name, convTypeToSrc v.Type, v.IsMutable)
                 // 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

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
+
+[<Fact>]
+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<int>)
+    let sharedVar2 = Var("y", typeof<string>)
+    let sharedVar3 = Var("z", typeof<int>)
+    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<exn>()
+    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))
+
+[<Fact>]
+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<int>; typeof<string>; typeof<DateTime>; typeof<int[]>;
+                         typeof<System.Collections.Generic.List<int>>;
+                         typeof<System.Collections.Generic.Dictionary<string, int>>;
+                         typeof<int option>; typeof<Result<int,string>> |]
+
+    let errors = System.Collections.Concurrent.ConcurrentBag<exn>()
+    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))

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))
 
+[<Fact>]
+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<obj>, 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<exn>()
+    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<CustomAttributeTypedArgument> values — the format that
 // real .NET reflection (GetCustomAttributesData()) uses for array-typed constructor arguments —
 // are correctly unwrapped by transValue in defineCustomAttrs.