Merge pull request #1505 from manofstick/manofstick-threading-concerns

Race Conditions in FSharp.Core

Author: KevinRansom

src/fsharp/FSharp.Core/quotations.fs

@@ -91,14 +91,16 @@ open Helpers
 [<CompiledName("FSharpVar")>]
 [<System.Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Usage","CA2218:OverrideGetHashCodeOnOverridingEquals",Justification="Equals override does not equate further objects, so default GetHashCode is still valid")>]
 type Var(name: string, typ:Type, ?isMutable: bool) =
-
     inherit obj()
-    static let mutable lastStamp = 0L
+
+    static let getStamp =
+        let mutable lastStamp = -1L // first value retrieved will be 0
+        fun () -> System.Threading.Interlocked.Increment &lastStamp
+
     static let globals = new Dictionary<(string*Type),Var>(11)
 
-    let stamp = lastStamp    
+    let stamp = getStamp ()
     let isMutable = defaultArg isMutable false
-    do lock globals (fun () -> lastStamp <- lastStamp + 1L)
 
     member v.Name = name
     member v.IsMutable = isMutable

src/fsharp/FSharp.Core/reflect.fs

@@ -404,8 +404,10 @@ module internal Impl =
                 | _ -> invalidArg "tys" (SR.GetString(SR.invalidTupleTypes))
 
             let tables = if isStruct then valueTupleTypes else refTupleTypes
-            match tables.TryGetValue(asm) with
+            match lock dictionaryLock (fun () -> tables.TryGetValue(asm)) with
             | false, _ ->
+                // the Dictionary<>s here could be ConcurrentDictionary<>'s, but then
+                // that would lock while initializing the Type array (maybe not an issue)
                 let a = ref (Array.init<Type> 8 (fun i -> makeIt (i + 1)))
                 lock dictionaryLock (fun () ->  match tables.TryGetValue(asm) with
                                                 | true, t -> a := t