Fix 581 - Async.RunSynchronously tries to reuse current thread

src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs

@@ -79,6 +79,21 @@ type AsyncType() =
 
         ()
 
+    [<Test>]
+    member this.AsyncRunSynchronouslyReusesThreadPoolThread() =
+        let action = async { async { () } |> Async.RunSynchronously }
+        let computation =
+            [| for i in 1 .. 1000 -> action |]
+            |> Async.Parallel
+        // This test needs approximately 1000 ThreadPool threads
+        // if Async.RunSynchronously doesn't reuse them.
+        // In such case TimeoutException is raised
+        // since ThreadPool cannot provide 1000 threads in 1 second
+        // (the number of threads in ThreadPool is adjusted slowly).
+        Assert.DoesNotThrow(fun () ->
+            Async.RunSynchronously(computation, timeout = 1000)
+            |> ignore)
+
     [<Test>]
     member this.AsyncSleepCancellation1() =
         ignoreSynchCtx (fun () ->

src/fsharp/FSharp.Core/control.fs

@@ -1226,7 +1226,7 @@ namespace Microsoft.FSharp.Control
 
     module CancellationTokenOps =
         /// Run the asynchronous workflow and wait for its result.
-        let RunSynchronously (token:CancellationToken,computation,timeout) =
+        let private RunSynchronouslyInAnotherThread (token:CancellationToken,computation,timeout) =
             let token,innerCTS = 
                 // If timeout is provided, we govern the async by our own CTS, to cancel
                 // when execution times out. Otherwise, the user-supplied token governs the async.
@@ -1261,6 +1261,40 @@ namespace Microsoft.FSharp.Control
                 |   None -> ()
                 commit res
 
+        let private RunSynchronouslyInCurrentThread (token:CancellationToken,computation) =
+            use resultCell = new ResultCell<Result<_>>()
+            let trampolineHolder = TrampolineHolder()
+
+            trampolineHolder.Protect
+                (fun () ->
+                    startA
+                        token
+                        trampolineHolder
+                        (fun res -> resultCell.RegisterResult(Ok(res),reuseThread=true))
+                        (fun edi -> resultCell.RegisterResult(Error(edi),reuseThread=true))
+                        (fun exn -> resultCell.RegisterResult(Canceled(exn),reuseThread=true))
+                        computation)
+            |> unfake
+
+            commit (resultCell.TryWaitForResultSynchronously() |> Option.get)
+
+        let RunSynchronously (token:CancellationToken,computation,timeout) =
+            // Reuse the current ThreadPool thread if possible. Unfortunately
+            // Thread.IsThreadPoolThread isn't available on all profiles so
+            // we approximate it by testing synchronization context for null.
+            match SynchronizationContext.Current, timeout with
+            | null, None -> RunSynchronouslyInCurrentThread (token, computation)
+            // When the timeout is given we need a dedicated thread
+            // which cancels the computation.
+            // Performing the cancellation in the ThreadPool eg. by using
+            // Timer from System.Threading or CancellationTokenSource.CancelAfter
+            // (which internally uses Timer) won't work properly
+            // when the ThreadPool is busy.
+            //
+            // And so when the timeout is given we always use the current thread
+            // for the cancellation and run the computation in another thread.
+            | _ -> RunSynchronouslyInAnotherThread (token, computation, timeout)
+
         let Start (token:CancellationToken,computation) =
             queueAsync 
                   token