From 39527b956af7bd44c5e1d2d98cdf617c3f7b2072 Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Thu, 17 Dec 2015 15:43:22 +0200 Subject: [PATCH 01/10] implement Async.Choice --- .../Microsoft.FSharp.Control/AsyncModule.fs | 121 ++++++++++++++++++ src/fsharp/FSharp.Core/control.fs | 44 +++++++ src/fsharp/FSharp.Core/control.fsi | 7 + 3 files changed, 172 insertions(+) diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 545c5011516..22a4c170701 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -6,8 +6,125 @@ namespace FSharp.Core.Unittests.FSharp_Core.Microsoft_FSharp_Control open System +open System.Threading open FSharp.Core.Unittests.LibraryTestFx open NUnit.Framework +open FsCheck + +[] +module ChoiceUtils = + + // FsCheck driven Async.Choice tests + + 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 + with + 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) + + module LeakUtils = // when testing for liveness, the things that we want to observe must always be created in @@ -295,6 +412,10 @@ type AsyncModule() = testErrorAndCancelRace (Async.Sleep (-5)) + [] + member this.``Async.Choice correctness and cancellation``() = + Check.QuickThrowOnFailure (normalize >> runChoice) + [] member this.``error on one workflow should cancel all others``() = let counter = diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 9da190dee93..40809908e81 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -1462,6 +1462,50 @@ namespace Microsoft.FSharp.Control |> unfake); FakeUnit)) + static member Choice(computations : Async<'T option> seq) : Async<'T option> = + unprotectedPrimitive(fun args -> + let result = + try Choice1Of2 <| Seq.toArray computations + with exn -> Choice2Of2 <| ExceptionDispatchInfo.RestoreOrCapture(exn) + + match result with + | Choice2Of2 edi -> args.aux.econt edi + | Choice1Of2 [||] -> args.cont None + | Choice1Of2 [|P body|] -> body args + | 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 _ when Interlocked.Increment exnCount = 1 -> + innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont result) + | None when Interlocked.Increment noneCount = computations.Length -> + innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont None) + + | _ -> 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. diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 4a6280cb94f..c459a383490 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -268,6 +268,13 @@ namespace Microsoft.FSharp.Control /// A computation that returns an array of values from the sequence of input computations. static member Parallel : computations:seq> -> Async<'T[]> + /// Creates an asynchronous computation that executes all the given asynchronous computations, + /// and returns the result of the first succeeding computation (i.e. the first computation with a result that is not None). + /// + /// A sequence of distinct computations to be parallelized. + /// A computation that returns the first succeeding computation in the sequence of input computations. + static member Choice : computations:seq> -> Async<'T option> + //---------- Thread Control /// Creates an asynchronous computation that creates a new thread and runs From c4bdb2dcb474a4f4be5de8abe57b345d8a5b6fb2 Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Thu, 17 Dec 2015 16:08:34 +0200 Subject: [PATCH 02/10] add Async.Choice to SurfaceArea tests --- src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs | 1 + src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs | 1 + 2 files changed, 2 insertions(+) diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs index 16f23c386f3..c3d2bf05382 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net40.fs +++ b/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) diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs index 2114a808c20..7a73cd45a6b 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs +++ b/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) From 54de8fa8bb92f06aa0ac78c1a2979a1633c52fcc Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Thu, 17 Dec 2015 16:28:47 +0200 Subject: [PATCH 03/10] add build conditionals for .net portable --- .../FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 22a4c170701..9eaa098d1a8 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -9,6 +9,7 @@ open System open System.Threading open FSharp.Core.Unittests.LibraryTestFx open NUnit.Framework +#if !(FSHARP_CORE_PORTABLE || FSHARP_CORE_NETCORE_PORTABLE) open FsCheck [] @@ -124,7 +125,7 @@ module ChoiceUtils = 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 @@ -411,10 +412,11 @@ type AsyncModule() = member this.``RaceBetweenCancellationAndError.Sleep``() = testErrorAndCancelRace (Async.Sleep (-5)) - +#if !(FSHARP_CORE_PORTABLE || FSHARP_CORE_NETCORE_PORTABLE) [] member this.``Async.Choice correctness and cancellation``() = Check.QuickThrowOnFailure (normalize >> runChoice) +#endif [] member this.``error on one workflow should cancel all others``() = From 43dd8714b52a19d5af95ecd36788a979fda93632 Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Thu, 17 Dec 2015 16:35:56 +0200 Subject: [PATCH 04/10] update Async.Choice description --- src/fsharp/FSharp.Core/control.fsi | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index c459a383490..54779a732c0 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -268,10 +268,18 @@ namespace Microsoft.FSharp.Control /// A computation that returns an array of values from the sequence of input computations. static member Parallel : computations:seq> -> Async<'T[]> - /// Creates an asynchronous computation that executes all the given asynchronous computations, - /// and returns the result of the first succeeding computation (i.e. the first computation with a result that is not None). + /// 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'). /// - /// A sequence of distinct computations to be parallelized. + /// 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. + /// A sequence of computations to be parallelized. /// A computation that returns the first succeeding computation in the sequence of input computations. static member Choice : computations:seq> -> Async<'T option> From 8b4cdd412f7686a9b7ab72a6c9958fd2bf07492a Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Thu, 17 Dec 2015 17:31:01 +0200 Subject: [PATCH 05/10] incorporate surface test changes --- .../FSharp.Core.Unittests/LibraryTestFx.fs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs b/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs index ade35128f10..6f191f0ca78 100644 --- a/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs +++ b/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) From 4f44983a66b5213a0ab6ecd87864193101d147e4 Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Thu, 17 Dec 2015 18:27:08 +0200 Subject: [PATCH 06/10] add choice to all surface area test definitions --- src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs | 1 + src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs | 1 + src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs | 1 + src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs | 1 + src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs | 1 + 5 files changed, 5 insertions(+) diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs index b3dc06c4a32..e52f2822d3d 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.Silverlight.2.0.fs +++ b/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) diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs index 47e4e70d6d1..5020798222a 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.net20.fs +++ b/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) diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs index aaa2e562936..a67765f76f1 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable47.fs +++ b/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) diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs index a31efab40e3..95909597024 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable7.fs +++ b/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) diff --git a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs b/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs index aec1daf060a..57a4eccb13c 100644 --- a/src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable78.fs +++ b/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) From e758c51f22b02ce10061bee5fee8c2eb2e3a89e0 Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Thu, 17 Dec 2015 23:50:45 +0200 Subject: [PATCH 07/10] incorporate feedback --- .../Microsoft.FSharp.Control/AsyncModule.fs | 14 +++++++------ src/fsharp/FSharp.Core/control.fs | 20 +++++++++++-------- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 9eaa098d1a8..703788c4dec 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -11,11 +11,13 @@ 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) [] module ChoiceUtils = - // FsCheck driven Async.Choice tests + // FsCheck driven Async.Choice specification test exception ChoiceExn of index:int @@ -24,7 +26,7 @@ module ChoiceUtils = | NoneResultAfter of timeout:int | SomeResultAfter of timeout:int | ExceptionAfter of timeout:int - with + member c.Timeout = match c with | NoneResultAfter t -> t @@ -61,7 +63,7 @@ module ChoiceUtils = 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) + | ExceptionAfter t -> returnAfter t (fun () -> raise (ChoiceExn index)) let choiceWorkflow = ops |> List.mapi mkOp |> Async.Choice @@ -92,7 +94,7 @@ module ChoiceUtils = } |> Seq.min let verifyIndex index = - if index < 0 || index >= ops.Length then + 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 @@ -413,8 +415,8 @@ type AsyncModule() = testErrorAndCancelRace (Async.Sleep (-5)) #if !(FSHARP_CORE_PORTABLE || FSHARP_CORE_NETCORE_PORTABLE) - [] - member this.``Async.Choice correctness and cancellation``() = + [] + member this.``Async.Choice specification test``() = Check.QuickThrowOnFailure (normalize >> runChoice) #endif diff --git a/src/fsharp/FSharp.Core/control.fs b/src/fsharp/FSharp.Core/control.fs index 40809908e81..5ba22fb7dcc 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -1465,13 +1465,12 @@ namespace Microsoft.FSharp.Control static member Choice(computations : Async<'T option> seq) : Async<'T option> = unprotectedPrimitive(fun args -> let result = - try Choice1Of2 <| Seq.toArray computations - with exn -> Choice2Of2 <| ExceptionDispatchInfo.RestoreOrCapture(exn) + 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 [|P body|] -> body args | Choice1Of2 computations -> protectedPrimitiveCore args (fun args -> let ({ aux = aux } as args) = delimitSyncContext args @@ -1482,12 +1481,17 @@ namespace Microsoft.FSharp.Control let scont (result : 'T option) = match result with - | Some _ when Interlocked.Increment exnCount = 1 -> - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont result) - | None when Interlocked.Increment noneCount = computations.Length -> - innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont None) + | Some _ -> + if Interlocked.Increment exnCount = 1 then + innerCts.Cancel(); trampolineHolder.Protect(fun () -> args.cont result) + else + FakeUnit - | _ -> 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 From b81dea5f757779d3866eb386054220377f50a640 Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Fri, 18 Dec 2015 00:26:30 +0200 Subject: [PATCH 08/10] fix parameter names in Async.Parallel & Async.Choice. --- src/fsharp/FSharp.Core/control.fsi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 54779a732c0..bbefd2623d6 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -264,7 +264,7 @@ 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. - /// A sequence of distinct computations to be parallelized. + /// A sequence of distinct computations to be parallelized. /// A computation that returns an array of values from the sequence of input computations. static member Parallel : computations:seq> -> Async<'T[]> @@ -279,7 +279,7 @@ 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. - /// A sequence of computations to be parallelized. + /// A sequence of computations to be parallelized. /// A computation that returns the first succeeding computation in the sequence of input computations. static member Choice : computations:seq> -> Async<'T option> From 28d0c0c038a71f9fa320c352c215c2a04598fd91 Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Fri, 18 Dec 2015 12:29:24 +0200 Subject: [PATCH 09/10] improve async.choice xml doc --- src/fsharp/FSharp.Core/control.fsi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index bbefd2623d6..3da58dbc12f 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -280,7 +280,7 @@ namespace Microsoft.FSharp.Control /// If cancelled, the computation will cancel any remaining child computations but will still wait /// for the other child computations to complete. /// A sequence of computations to be parallelized. - /// A computation that returns the first succeeding computation in the sequence of input computations. + /// A computation that returns the first of the input computations to succeed. static member Choice : computations:seq> -> Async<'T option> //---------- Thread Control From 1da20e4ce0a85032fb8f73b00aea2ef7a6c614bc Mon Sep 17 00:00:00 2001 From: Eirik Tsarpalis Date: Fri, 18 Dec 2015 12:37:13 +0200 Subject: [PATCH 10/10] changes to choice xml doc --- src/fsharp/FSharp.Core/control.fsi | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/FSharp.Core/control.fsi b/src/fsharp/FSharp.Core/control.fsi index 3da58dbc12f..71d00d2c191 100644 --- a/src/fsharp/FSharp.Core/control.fsi +++ b/src/fsharp/FSharp.Core/control.fsi @@ -269,10 +269,10 @@ namespace Microsoft.FSharp.Control static member Parallel : computations:seq> -> Async<'T[]> /// 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'). + /// returning the result of the first succeeding computation (one whose result is 'Some x'). + /// If all child computations complete with None, the parent computation also returns None. /// - /// 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. /// @@ -280,7 +280,7 @@ namespace Microsoft.FSharp.Control /// If cancelled, the computation will cancel any remaining child computations but will still wait /// for the other child computations to complete. /// A sequence of computations to be parallelized. - /// A computation that returns the first of the input computations to succeed. + /// A computation that returns the first succeeding computation. static member Choice : computations:seq> -> Async<'T option> //---------- Thread Control