Implement Async.Choice

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

@@ -6,8 +6,128 @@
 namespace FSharp.Core.Unittests.FSharp_Core.Microsoft_FSharp_Control
 
 open System
+open System.Threading
 open FSharp.Core.Unittests.LibraryTestFx
 open NUnit.Framework
+#if !(FSHARP_CORE_PORTABLE || FSHARP_CORE_NETCORE_PORTABLE)
+open FsCheck
+#endif
+
+#if !(FSHARP_CORE_PORTABLE || FSHARP_CORE_NETCORE_PORTABLE)
+[<AutoOpen>]
+module ChoiceUtils =
+
+    // FsCheck driven Async.Choice specification test
+
+    exception ChoiceExn of index:int
+
+    /// represents a child computation of a choice workflow
+    type ChoiceOp =
+        | NoneResultAfter of timeout:int
+        | SomeResultAfter of timeout:int
+        | ExceptionAfter of timeout:int
+
+        member c.Timeout =
+            match c with
+            | NoneResultAfter t -> t
+            | SomeResultAfter t -> t
+            | ExceptionAfter t -> t
+
+    /// represent a choice worfklow
+    type ChoiceWorkflow = ChoiceWorkflow of children:ChoiceOp list * cancelAfter:int option
+
+    /// normalizes random timeout arguments
+    let normalize (ChoiceWorkflow(ops, cancelAfter)) =
+        let ms t = 2000 * (abs t % 15) // timeouts only positive multiples of 2 seconds, up to 30 seconds
+        let mkOp op =
+            match op with
+            | NoneResultAfter t -> NoneResultAfter (ms t)
+            | SomeResultAfter t -> SomeResultAfter (ms t)
+            | ExceptionAfter t -> ExceptionAfter (ms t)
+
+        let ops = ops |> List.map mkOp
+        let cancelAfter = cancelAfter |> Option.map ms
+        ChoiceWorkflow(ops, cancelAfter)
+
+    /// runs specified choice workflow and checks that
+    /// Async.Choice spec is satisfied
+    let runChoice (ChoiceWorkflow(ops, cancelAfter)) =
+        // Step 1. build a choice workflow from the abstract representation
+        let completed = ref 0
+        let returnAfter time f = async {
+            do! Async.Sleep time
+            let _ = Interlocked.Increment completed
+            return f ()
+        }
+
+        let mkOp (index : int) = function
+            | NoneResultAfter t -> returnAfter t (fun () ->  None)
+            | SomeResultAfter t -> returnAfter t (fun () -> Some index)
+            | ExceptionAfter t -> returnAfter t (fun () -> raise (ChoiceExn index))
+
+        let choiceWorkflow = ops |> List.mapi mkOp |> Async.Choice
+
+        // Step 2. run the choice workflow and keep the results
+        let result =
+            let cancellationToken =
+                match cancelAfter with
+                | Some ca -> 
+                    let cts = new CancellationTokenSource()
+                    cts.CancelAfter(ca)
+                    Some cts.Token
+                | None -> None
+
+            try Async.RunSynchronously(choiceWorkflow, ?cancellationToken = cancellationToken) |> Choice1Of2 
+            with e -> Choice2Of2 e
+
+        // Step 3. check that results are up to spec
+        let getMinTime() =
+            seq {
+                yield Int32.MaxValue // "infinity": avoid exceptions if list is empty
+
+                for op in ops do 
+                    match op with
+                    | NoneResultAfter _ -> ()
+                    | op -> yield op.Timeout
+
+                match cancelAfter with Some t -> yield t | None -> ()
+            } |> Seq.min
+
+        let verifyIndex index =
+            if index < 0 || index >= ops.Length then
+                Assert.Fail "Returned choice index is out of bounds."
+
+        // Step 3a. check that output is up to spec
+        match result with
+        | Choice1Of2 (Some index) ->
+            verifyIndex index
+            match ops.[index] with
+            | SomeResultAfter timeout -> Assert.AreEqual(getMinTime(), timeout)
+            | op -> Assert.Fail <| sprintf "Should be 'Some' but got %A" op
+
+        | Choice1Of2 None ->
+            Assert.True(ops |> List.forall (function NoneResultAfter _ -> true | _ -> false))
+
+        | Choice2Of2 (:? OperationCanceledException) ->
+            match cancelAfter with
+            | None -> Assert.Fail "Got unexpected cancellation exception."
+            | Some ca -> Assert.AreEqual(getMinTime(), ca)
+
+        | Choice2Of2 (ChoiceExn index) ->
+            verifyIndex index
+            match ops.[index] with
+            | ExceptionAfter timeout -> Assert.AreEqual(getMinTime(), timeout)
+            | op -> Assert.Fail <| sprintf "Should be 'Exception' but got %A" op
+
+        | Choice2Of2 e -> Assert.Fail(sprintf "Unexpected exception %O" e)
+
+        // Step 3b. check that nested cancellation happens as expected
+        if not <| List.isEmpty ops then
+            let minTimeout = getMinTime()
+            let minTimeoutOps = ops |> Seq.filter (fun op -> op.Timeout <= minTimeout) |> Seq.length
+            Assert.LessOrEqual(!completed, minTimeoutOps)
+
+#endif
 
 module LeakUtils =
     // when testing for liveness, the things that we want to observe must always be created in
@@ -294,6 +414,11 @@ type AsyncModule() =
     member this.``RaceBetweenCancellationAndError.Sleep``() =
         testErrorAndCancelRace (Async.Sleep (-5))
 
+#if !(FSHARP_CORE_PORTABLE || FSHARP_CORE_NETCORE_PORTABLE)
+    [<Test; Category("CHOICE")>]
+    member this.``Async.Choice specification test``() =
+        Check.QuickThrowOnFailure (normalize >> runChoice)
+#endif
 
     [<Test>]
     member this.``error on one workflow should cancel all others``() =

src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs

@@ -116,10 +116,13 @@ module SurfaceArea =
             |> Array.map (fun v -> sprintf "%s: %s" (v.ReflectedType.ToString()) (v.ToString()))
             #endif
 
-        types 
-        |> Array.collect getTypeMemberStrings
-        |> Array.sort
-        |> String.concat "\r\n"
+        let actual =
+            types 
+            |> Array.collect getTypeMemberStrings
+            |> Array.sort
+            |> String.concat "\r\n"
+
+        asm,actual
 
     // verify public surface area matches expected
     let verify expected platform fileName =  
@@ -133,7 +136,8 @@ module SurfaceArea =
         let normalize (s:string) =
             Regex.Replace(s, "(\\r\\n|\\n)+", "\r\n").Trim([|'\r';'\n'|])
 
-        let actual = getActual () |> normalize
+        let asm, actualNotNormalized = getActual ()
+        let actual = actualNotNormalized |> normalize
         let expected = expected |> normalize
 
-        Assert.AreEqual(expected, actual, sprintf "\r\n%s\r\n\r\n Expected and actual surface area don't match. To see the delta, run\r\nwindiff %s %s" actual fileName logFile)
+        Assert.AreEqual(expected, actual, sprintf "\r\nAssembly: %A\r\n\r\n%s\r\n\r\n Expected and actual surface area don't match. To see the delta, run\r\nwindiff %s %s" asm actual fileName logFile)

src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs

@@ -480,6 +480,7 @@ Microsoft.FSharp.Control.FSharpAsync: Boolean Equals(System.Object)
 Microsoft.FSharp.Control.FSharpAsync: Int32 GetHashCode()
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Control.FSharpAsync`1[T]] StartChild[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpOption`1[System.Int32])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpChoice`2[T,System.Exception]] Catch[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
+Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]] Choice[T](System.Collections.Generic.IEnumerable`1[Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]]])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Ignore[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Sleep(Int32)
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] SwitchToContext(System.Threading.SynchronizationContext)

src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs

@@ -551,6 +551,7 @@ Microsoft.FSharp.Control.FSharpAsync: Boolean Equals(System.Object)
 Microsoft.FSharp.Control.FSharpAsync: Int32 GetHashCode()
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Control.FSharpAsync`1[T]] StartChild[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpOption`1[System.Int32])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpChoice`2[T,System.Exception]] Catch[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
+Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]] Choice[T](System.Collections.Generic.IEnumerable`1[Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]]])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Ignore[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Sleep(Int32)
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] SwitchToContext(System.Threading.SynchronizationContext)

src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs

@@ -573,6 +573,7 @@ Microsoft.FSharp.Control.FSharpAsync: Boolean Equals(System.Object)
 Microsoft.FSharp.Control.FSharpAsync: Int32 GetHashCode()
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Control.FSharpAsync`1[T]] StartChild[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpOption`1[System.Int32])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpChoice`2[T,System.Exception]] Catch[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
+Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]] Choice[T](System.Collections.Generic.IEnumerable`1[Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]]])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] AwaitTask(System.Threading.Tasks.Task)
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Ignore[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Sleep(Int32)

src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs

@@ -560,6 +560,7 @@ Microsoft.FSharp.Control.FSharpAsync: Boolean Equals(System.Object)
 Microsoft.FSharp.Control.FSharpAsync: Int32 GetHashCode()
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Control.FSharpAsync`1[T]] StartChild[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpOption`1[System.Int32])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpChoice`2[T,System.Exception]] Catch[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
+Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]] Choice[T](System.Collections.Generic.IEnumerable`1[Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]]])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] AwaitTask(System.Threading.Tasks.Task)
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Ignore[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Sleep(Int32)

src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs

@@ -557,6 +557,7 @@ Microsoft.FSharp.Control.FSharpAsync: Boolean Equals(System.Object)
 Microsoft.FSharp.Control.FSharpAsync: Int32 GetHashCode()
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Control.FSharpAsync`1[T]] StartChild[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpOption`1[System.Int32])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpChoice`2[T,System.Exception]] Catch[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
+Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]] Choice[T](System.Collections.Generic.IEnumerable`1[Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]]])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] AwaitTask(System.Threading.Tasks.Task)
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Ignore[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Sleep(Int32)

src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs

@@ -573,6 +573,7 @@ Microsoft.FSharp.Control.FSharpAsync: Boolean Equals(System.Object)
 Microsoft.FSharp.Control.FSharpAsync: Int32 GetHashCode()
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Control.FSharpAsync`1[T]] StartChild[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpOption`1[System.Int32])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpChoice`2[T,System.Exception]] Catch[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
+Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]] Choice[T](System.Collections.Generic.IEnumerable`1[Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]]])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] AwaitTask(System.Threading.Tasks.Task)
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Ignore[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Sleep(Int32)

src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs

@@ -560,6 +560,7 @@ Microsoft.FSharp.Control.FSharpAsync: Boolean Equals(System.Object)
 Microsoft.FSharp.Control.FSharpAsync: Int32 GetHashCode()
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Control.FSharpAsync`1[T]] StartChild[T](Microsoft.FSharp.Control.FSharpAsync`1[T], Microsoft.FSharp.Core.FSharpOption`1[System.Int32])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpChoice`2[T,System.Exception]] Catch[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
+Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]] Choice[T](System.Collections.Generic.IEnumerable`1[Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.FSharpOption`1[T]]])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] AwaitTask(System.Threading.Tasks.Task)
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Ignore[T](Microsoft.FSharp.Control.FSharpAsync`1[T])
 Microsoft.FSharp.Control.FSharpAsync: Microsoft.FSharp.Control.FSharpAsync`1[Microsoft.FSharp.Core.Unit] Sleep(Int32)

src/fsharp/FSharp.Core/control.fs

@@ -1462,6 +1462,54 @@ namespace Microsoft.FSharp.Control
                             |> unfake);
                     FakeUnit))
 
+        static member Choice(computations : Async<'T option> seq) : Async<'T option> =
+            unprotectedPrimitive(fun args ->
+                let result =
+                    try Seq.toArray computations |> Choice1Of2
+                    with exn -> ExceptionDispatchInfo.RestoreOrCapture exn |> Choice2Of2
+
+                match result with
+                | Choice2Of2 edi -> args.aux.econt edi
+                | Choice1Of2 [||] -> args.cont None
+                | Choice1Of2 computations ->
+                    protectedPrimitiveCore args (fun args ->
+                        let ({ aux = aux } as args) = delimitSyncContext args
+                        let noneCount = ref 0
+                        let exnCount = ref 0
+                        let innerCts = new LinkedSubSource(aux.token)
+                        let trampolineHolder = aux.trampolineHolder
+
+                        let scont (result : 'T option) =
+                            match result with
+                            | Some _ -> 
+                                if Interlocked.Increment exnCount = 1 then
+                                    innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont result)
+                                else
+                                    FakeUnit
+
+                            | None ->
+                                if Interlocked.Increment noneCount = computations.Length then
+                                    innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont None)
+                                else
+                                    FakeUnit
+
+                        let econt (exn : ExceptionDispatchInfo) =
+                            if Interlocked.Increment exnCount = 1 then 
+                                innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.aux.econt exn)
+                            else
+                                FakeUnit
+
+                        let ccont (exn : OperationCanceledException) =
+                            if Interlocked.Increment exnCount = 1 then
+                                innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.aux.ccont exn)
+                            else
+                                FakeUnit
+
+                        for c in computations do
+                            queueAsync innerCts.Token scont econt ccont c |> unfake
+
+                        FakeUnit))
+
 #if FX_NO_TASK
 #else
     // Contains helpers that will attach continuation to the given task.

src/fsharp/FSharp.Core/control.fsi

@@ -264,10 +264,25 @@ namespace Microsoft.FSharp.Control
         /// The overall computation will respond to cancellation while executing the child computations.
         /// If cancelled, the computation will cancel any remaining child computations but will still wait
         /// for the other child computations to complete.</remarks>
-        /// <param name="computationList">A sequence of distinct computations to be parallelized.</param>
+        /// <param name="computations">A sequence of distinct computations to be parallelized.</param>
         /// <returns>A computation that returns an array of values from the sequence of input computations.</returns>
         static member Parallel : computations:seq<Async<'T>> -> Async<'T[]>
 
+        /// <summary>Creates an asynchronous computation that executes all given asynchronous computations in parallel, 
+        /// returning the result of the first succeeding computation (i.e. the first computation with a result that is 'Some x').</summary>
+        ///
+        /// <remarks>If all child computations complete with None, the parent computation also returns None.
+        /// 
+        /// If any child computation raises an exception, then the overall computation will trigger an 
+        /// exception, and cancel the others. 
+        ///
+        /// The overall computation will respond to cancellation while executing the child computations.
+        /// If cancelled, the computation will cancel any remaining child computations but will still wait
+        /// for the other child computations to complete.</remarks>
+        /// <param name="computations">A sequence of computations to be parallelized.</param>
+        /// <returns>A computation that returns the first succeeding computation in the sequence of input computations.</returns>
+        static member Choice : computations:seq<Async<'T option>> -> Async<'T option>
+
         //---------- Thread Control
 
         /// <summary>Creates an asynchronous computation that creates a new thread and runs