From 6a9afaca510c652bda7f753976a6dbb205bf7c28 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Sat, 28 Nov 2015 10:50:18 +0100 Subject: [PATCH 1/3] Create Async.Choice function --- .../Microsoft.FSharp.Control/AsyncModule.fs | 89 ++++++++++++++++++- .../SurfaceArea.net40.fs | 1 + src/fsharp/FSharp.Core/control.fs | 31 +++++++ src/fsharp/FSharp.Core/control.fsi | 7 ++ 4 files changed, 127 insertions(+), 1 deletion(-) 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..028cd3b848d 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 @@ -8,6 +8,15 @@ namespace FSharp.Core.Unittests.FSharp_Core.Microsoft_FSharp_Control open System open FSharp.Core.Unittests.LibraryTestFx open NUnit.Framework +#if FSHARP_CORE_PORTABLE +// nothing +#else +#if FSHARP_CORE_NETCORE_PORTABLE +// nothing +#else +open FsCheck +#endif +#endif module LeakUtils = // when testing for liveness, the things that we want to observe must always be created in @@ -296,7 +305,7 @@ type AsyncModule() = [] - member this.``error on one workflow should cancel all others``() = + member this.``error on one workflow should cancel all other parallel workflows``() = let counter = async { let counter = ref 0 @@ -314,6 +323,84 @@ type AsyncModule() = Assert.AreEqual(0, counter) +#if FSHARP_CORE_PORTABLE +// nothing +#else +#if FSHARP_CORE_NETCORE_PORTABLE +// nothing +#else + + [] + member this.``Async.Choice takes first result that is <> None``() = + let returnFirstResult (PositiveInt n) (PositiveInt i) x = + n > i ==> + let result = + async { + let job j = async { if j = i then return Some x else return None } + + return! Async.Choice [ for j in 1 .. n -> job j ] + } |> Async.RunSynchronously + + Some x = result + + Check.QuickThrowOnFailure returnFirstResult + + [] + member this.``Async.Choice reports error when things crash``() = + try + async { + let job i = async { failwith "crashed"; return None } + + return! Async.Choice [ for i in 1 .. 100 -> job i ] + } + |> Async.RunSynchronously + |> ignore + + failwith "expected an exception" + with exn when exn.Message = "crashed" -> () + + [] + member this.``Async.Choice returns None if no tasks are given``() = + let result = + Async.Choice [ ] + |> Async.RunSynchronously + + Assert.AreEqual(None, result) + + [] + member this.``Async.Choice returns None if all results are None``() = + let returnNone (PositiveInt n) x = + let result = + async { + let job j = async { return None } + + return! Async.Choice [ for j in 1 .. n -> job j ] + } |> Async.RunSynchronously + + None = result + + Check.QuickThrowOnFailure returnNone + + [] + member this.``Async.Choice returns fastest response that is not None``() = + let delay interval result = + async { + do! Async.Sleep interval + return! async { + printfn "returning %A after %d ms." result interval + return result } + } + + let result = + [ delay 100 None ; delay 1000 (Some 1) ; delay 500 (Some 2) ] + |> Async.Choice + |> Async.RunSynchronously + + Assert.AreEqual(Some 2, result) + +#endif +#endif + [] member this.``AwaitWaitHandle.ExceptionsAfterTimeout``() = let wh = new System.Threading.ManualResetEvent(false) 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/control.fs b/src/fsharp/FSharp.Core/control.fs index 9da190dee93..124900af2af 100644 --- a/src/fsharp/FSharp.Core/control.fs +++ b/src/fsharp/FSharp.Core/control.fs @@ -1528,6 +1528,37 @@ namespace Microsoft.FSharp.Control let token = defaultArg cancellationToken defaultCancellationTokenSource.Token CancellationTokenOps.StartWithContinuations(token, computation, id, (fun edi -> edi.ThrowAny()), ignore) + static member Choice(computations : Async<'T option> seq) = async { + match Seq.toArray computations with + | [||] -> return None + | [|t|] -> return! t + | computations -> + + let! t = Async.CancellationToken + return! Async.FromContinuations <| + fun (sc,ec,cc) -> + let noneCount = ref 0 + let exnCount = ref 0 + let innerCts = CancellationTokenSource.CreateLinkedTokenSource t + + let scont (result : 'T option) = + match result with + | Some _ when Interlocked.Increment exnCount = 1 -> innerCts.Cancel() ; sc result + | None when Interlocked.Increment noneCount = computations.Length -> sc None + | _ -> () + + let econt (exn : exn) = + if Interlocked.Increment exnCount = 1 then + innerCts.Cancel() ; ec exn + + let ccont (exn : OperationCanceledException) = + if Interlocked.Increment exnCount = 1 then + innerCts.Cancel(); cc exn + + for task in computations do + ignore <| System.Threading.Tasks.Task.Factory.StartNew(fun () -> Async.StartWithContinuations(task, scont, econt, ccont, innerCts.Token)) + } + #if FSHARP_CORE_NETCORE_PORTABLE static member Sleep(dueTime : int) : Async = // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the Delay 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 57b7f9b0c4e03bffe556e787b01f4526b4014327 Mon Sep 17 00:00:00 2001 From: enricosada Date: Tue, 1 Dec 2015 18:51:32 +0100 Subject: [PATCH 2/3] fix portable 259 tests --- src/fsharp/FSharp.Core.Unittests/SurfaceArea.portable259.fs | 1 + 1 file changed, 1 insertion(+) 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 a5685eda717862c88a5a76c21033bf90a91b53c8 Mon Sep 17 00:00:00 2001 From: enricosada Date: Tue, 1 Dec 2015 18:52:37 +0100 Subject: [PATCH 3/3] log assembly info in surface tests --- .../FSharp.Core.Unittests/LibraryTestFx.fs | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs b/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs index ade35128f10..1fff5215bd7 100644 --- a/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs +++ b/src/fsharp/FSharp.Core.Unittests/LibraryTestFx.fs @@ -115,11 +115,14 @@ module SurfaceArea = t.GetMembers() |> 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)