diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs
index c355dc020..a83aa9070 100644
--- a/src/FSharpPlus/Control/Monad.fs
+++ b/src/FSharpPlus/Control/Monad.fs
@@ -217,6 +217,7 @@ type TryWith =
static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWith , _) = async.TryWith ((computation ()), catchHandler)
#if !FABLE_COMPILER
static member TryWith (computation: unit -> Task<_> , catchHandler: exn -> Task<_> , _: TryWith, True) = Task.tryWith computation catchHandler
+ static member TryWith (computation: unit -> ValueTask<_> , catchHandler: exn -> ValueTask<_> , _: TryWith, True) = ValueTask.tryWith catchHandler computation
#endif
static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWith , _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_>
@@ -245,7 +246,8 @@ type TryFinally =
static member TryFinally ((computation: unit -> Id<_> , compensation: unit -> unit), _: TryFinally, _, _) = try computation () finally compensation ()
static member TryFinally ((computation: unit -> Async<_>, compensation: unit -> unit), _: TryFinally, _, _) = async.TryFinally (computation (), compensation) : Async<_>
#if !FABLE_COMPILER
- static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinally, _, True) = Task.tryFinally computation compensation : Task<_>
+ static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinally, _, True) = Task.tryFinally computation compensation : Task<_>
+ static member TryFinally ((computation: unit -> ValueTask<_>, compensation: unit -> unit), _: TryFinally, _, True) = ValueTask.tryFinally compensation computation : ValueTask<_>
#endif
static member TryFinally ((computation: unit -> Lazy<_> , compensation: unit -> unit), _: TryFinally, _, _) = lazy (try (computation ()).Force () finally compensation ()) : Lazy<_>
@@ -281,7 +283,8 @@ type Using =
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> 'R -> 'U , _: Using ) = (fun s -> try body resource s finally if not (isNull (box resource)) then resource.Dispose ()) : 'R->'U
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Async<'U>, _: Using ) = async.Using (resource, body)
#if !FABLE_COMPILER
- static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Task<'U>, _: Using ) = Task.using resource body
+ static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Task<'U> , _: Using) = Task.using resource body
+ static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> ValueTask<'U>, _: Using) = ValueTask.using resource body
#endif
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Lazy<'U> , _: Using ) = lazy (try (body resource).Force () finally if not (isNull (box resource)) then resource.Dispose ()) : Lazy<'U>
diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs
index 1ca8a6628..e70b516d8 100644
--- a/src/FSharpPlus/Extensions/Task.fs
+++ b/src/FSharpPlus/Extensions/Task.fs
@@ -11,10 +11,12 @@ module Task =
open System.Threading.Tasks
open FSharpPlus.Internals.Errors
- let private (|Canceled|Faulted|Completed|) (t: Task<'a>) =
- if t.IsCanceled then Canceled
- else if t.IsFaulted then Faulted (Unchecked.nonNull t.Exception)
- else Completed t.Result
+ /// Active pattern to match the state of a completed Task
+ let inline private (|Succeeded|Canceled|Faulted|) (t: Task<'a>) =
+ if t.IsCompletedSuccessfully then Succeeded t.Result
+ elif t.IsFaulted then Faulted (Unchecked.nonNull (t.Exception))
+ elif t.IsCanceled then Canceled
+ else invalidOp "Internal error: The task is not yet completed."
/// Creates a task workflow from 'source' another, mapping its result with 'f'.
let map (f: 'T -> 'U) (source: Task<'T>) : Task<'U> =
@@ -38,7 +40,7 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
try tcs.SetResult (f r)
with e -> tcs.SetException e
source.ContinueWith k |> ignore
@@ -70,7 +72,7 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
try tcs.SetResult (f x.Result r)
with e -> tcs.SetException e
y.ContinueWith k |> ignore
@@ -78,7 +80,7 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
try tcs.SetResult (f r y.Result)
with e -> tcs.SetException e
x.ContinueWith k |> ignore
@@ -87,12 +89,12 @@ module Task =
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
y.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r' ->
+ | Succeeded r' ->
try tcs.SetResult (f r r')
with e -> tcs.SetException e
) |> ignore) |> ignore
@@ -129,17 +131,17 @@ module Task =
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
y.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r' ->
+ | Succeeded r' ->
z.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r'' ->
+ | Succeeded r'' ->
try tcs.SetResult (f r r' r'')
with e -> tcs.SetException e
) |> ignore) |> ignore) |> ignore
@@ -183,7 +185,7 @@ module Task =
match t with
| Canceled -> cancelled <- true
| Faulted e -> failures[i] <- e.InnerExceptions
- | Completed r -> v.Value <- r
+ | Succeeded r -> v.Value <- r
trySet ()
if task1.IsCompleted && task2.IsCompleted then
@@ -235,7 +237,7 @@ module Task =
match t with
| Canceled -> cancelled <- true
| Faulted e -> failures[i] <- e.InnerExceptions
- | Completed r -> v.Value <- r
+ | Succeeded r -> v.Value <- r
trySet ()
if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then
@@ -273,7 +275,7 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
try tcs.SetResult (f.Result r)
with e -> tcs.SetException e
x.ContinueWith k |> ignore
@@ -281,7 +283,7 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
try tcs.SetResult (r x.Result)
with e -> tcs.SetException e
f.ContinueWith k |> ignore
@@ -290,12 +292,12 @@ module Task =
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
x.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r' ->
+ | Succeeded r' ->
try tcs.SetResult (r r')
with e -> tcs.SetException e
) |> ignore) |> ignore
@@ -319,24 +321,24 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r -> tcs.SetResult (x.Result, r)
+ | Succeeded r -> tcs.SetResult (x.Result, r)
y.ContinueWith k |> ignore
| _, TaskStatus.RanToCompletion ->
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r -> tcs.SetResult (r, y.Result)
+ | Succeeded r -> tcs.SetResult (r, y.Result)
x.ContinueWith k |> ignore
| _, _ ->
x.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r ->
+ | Succeeded r ->
y.ContinueWith (function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
- | Completed r' -> tcs.SetResult (r, r')) |> ignore) |> ignore
+ | Succeeded r' -> tcs.SetResult (r, r')) |> ignore) |> ignore
tcs.Task
/// Creates a task workflow from two workflows 'task1' and 'task2', tupling its results.
@@ -422,6 +424,29 @@ module Task =
(fun () -> body disp)
(fun () -> if not (isNull (box disp)) then disp.Dispose ())
+ /// Returns if it is not faulted, otherwise evaluates and returns the result.
+ ///
+ /// A thunk that provides an alternate task computation when evaluated.
+ /// The input task.
+ ///
+ /// The task if it is not faulted, else the result of evaluating .
+ /// is not evaluated unless is faulted.
+ ///
+ let inline orElseWith ([]fallbackThunk: exn -> Task<'T>) (source: Task<'T>) : Task<'T> =
+ let source = nullArgCheck (nameof source) source
+ tryWith (fun () -> source) fallbackThunk
+
+ /// Returns if it is not faulted, otherwise e.
+ ///
+ /// The alternative Task to use if is faulted.
+ /// The input task.
+ ///
+ /// The option if the option is Some, else the alternate option.
+ let orElse (fallbackTask: Task<'T>) (source: Task<'T>) : Task<'T> =
+ let fallbackTask = nullArgCheck (nameof fallbackTask) fallbackTask
+ let source = nullArgCheck (nameof source) source
+ orElseWith (fun _ -> fallbackTask) source
+
/// Creates a Task from a value
let result (value: 'T) = Task.FromResult value
diff --git a/src/FSharpPlus/Extensions/ValueTask.fs b/src/FSharpPlus/Extensions/ValueTask.fs
index 5d3bdcd66..97fe52d6f 100644
--- a/src/FSharpPlus/Extensions/ValueTask.fs
+++ b/src/FSharpPlus/Extensions/ValueTask.fs
@@ -11,10 +11,12 @@ module ValueTask =
open System.Threading.Tasks
open FSharpPlus.Internals.Errors
+ /// Active pattern to match the state of a completed ValueTask
let inline (|Succeeded|Canceled|Faulted|) (t: ValueTask<'T>) =
if t.IsCompletedSuccessfully then Succeeded t.Result
+ elif t.IsFaulted then Faulted (Unchecked.nonNull (t.AsTask().Exception))
elif t.IsCanceled then Canceled
- else Faulted (t.AsTask().Exception |> Unchecked.nonNull)
+ else invalidOp "Internal error: The task is not yet completed."
let inline continueTask (tcs: TaskCompletionSource<'Result>) (x: ValueTask<'t>) (k: 't -> unit) =
let f = function
@@ -241,6 +243,75 @@ module ValueTask =
else source.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> k source)
tcs.Task |> ValueTask
+ /// Used to de-sugar try .. with .. blocks in Computation Expressions.
+ let inline tryWith ([]compensation: exn -> ValueTask<'T>) ([]body: unit -> ValueTask<'T>) : ValueTask<'T> =
+ let unwrapException (agg: AggregateException) =
+ if agg.InnerExceptions.Count = 1 then agg.InnerExceptions.[0]
+ else agg :> Exception
+ try
+ let task = body ()
+ if task.IsCompleted then
+ match task with
+ | Succeeded _ -> task
+ | Faulted exn -> compensation (unwrapException exn)
+ | Canceled -> compensation (TaskCanceledException ())
+ else
+ let tcs = TaskCompletionSource<'T> ()
+ let f = function
+ | Succeeded r -> tcs.SetResult r
+ | Faulted exn -> continueTask tcs (compensation (unwrapException exn)) (fun r -> try tcs.SetResult r with e -> tcs.SetException e)
+ | Canceled -> continueTask tcs (compensation (TaskCanceledException ())) (fun r -> try tcs.SetResult r with e -> tcs.SetException e)
+ task.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f task)
+ ValueTask<'T> tcs.Task
+ with
+ | :? AggregateException as exn -> compensation (unwrapException exn)
+ | exn -> compensation exn
+
+ /// Used to de-sugar try .. finally .. blocks in Computation Expressions.
+ let inline tryFinally ([]compensation : unit -> unit) ([]body: unit -> ValueTask<'T>) : ValueTask<'T> =
+ let mutable ran = false
+ let compensation () =
+ if not ran then
+ compensation ()
+ ran <- true
+ try
+ let task = body ()
+ if task.IsCompleted then compensation (); task
+ else
+ let tcs = TaskCompletionSource<'T> ()
+ let f = function
+ | Succeeded r -> tcs.SetResult r
+ | Faulted exn -> tcs.SetException exn.InnerExceptions
+ | Canceled -> tcs.SetCanceled ()
+ task.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> compensation (); f task)
+ ValueTask<'T> tcs.Task
+ with _ ->
+ compensation ()
+ reraise ()
+
+ /// Used to de-sugar use .. blocks in Computation Expressions.
+ let inline using (disp: 'T when 'T :> IDisposable) ([]body: 'T -> ValueTask<'U>) =
+ tryFinally
+ (fun () -> if not (isNull (box disp)) then disp.Dispose ())
+ (fun () -> body disp)
+
+ /// Returns if it is not faulted, otherwise evaluates and returns the result.
+ ///
+ /// A thunk that provides an alternate task computation when evaluated.
+ /// The input task.
+ ///
+ /// The task if it is not faulted, else the result of evaluating .
+ /// is not evaluated unless is faulted.
+ ///
+ let inline orElseWith ([]fallbackThunk: exn -> ValueTask<'T>) (source: ValueTask<'T>) : ValueTask<'T> = tryWith fallbackThunk (fun () -> source)
+
+ /// Returns if it is not faulted, otherwise e.
+ ///
+ /// The alternative ValueTask to use if is faulted.
+ /// The input task.
+ ///
+ /// The option if the option is Some, else the alternate option.
+ let orElse (fallbackValueTask: ValueTask<'T>) (source: ValueTask<'T>) : ValueTask<'T> = orElseWith (fun _ -> fallbackValueTask) source
/// Raises an exception in the ValueTask
let raise<'TResult> (``exception``: exn) = ValueTask<'TResult> (Task.FromException<'TResult> ``exception``)
diff --git a/tests/FSharpPlus.Tests/ValueTask.fs b/tests/FSharpPlus.Tests/ValueTask.fs
index e9a63f237..86dc238b5 100644
--- a/tests/FSharpPlus.Tests/ValueTask.fs
+++ b/tests/FSharpPlus.Tests/ValueTask.fs
@@ -7,7 +7,6 @@ module ValueTask =
open System.Threading.Tasks
open NUnit.Framework
open FSharpPlus
- open FSharpPlus.Data
open FSharpPlus.Tests.Helpers
exception TestException of string
@@ -15,6 +14,12 @@ module ValueTask =
type ValueTask<'T> with
static member WhenAll (source: ValueTask<'T> seq) = source |> Seq.map (fun x -> x.AsTask ()) |> Task.WhenAll |> ValueTask<'T []>
static member WaitAny (source: ValueTask<'T>) = source.AsTask () |> Task.WaitAny |> ignore
+ static member Delay (millisecondsDelay: int) = ValueTask (Task.Delay millisecondsDelay)
+ member this.Wait() = this.AsTask().Wait()
+ member this.Exception = this.AsTask().Exception
+
+ module Async =
+ let StartAsValueTask (x: Async<'t>) = ValueTask<'t> (Async.StartAsTask x)
module ValueTask =
@@ -91,31 +96,31 @@ module ValueTask =
let binding isFailure x = if isFailure then raise (TestException "I was told to fail") else ValueTask.FromResult (x + 10)
let r01 = ValueTask.map (mapping false) (e1 ())
- r01.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
+ r01.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
let r02 = ValueTask.map (mapping true) (x1 ())
- r02.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "I was told to fail"]
+ r02.Exception.InnerExceptions |> areEquivalent [TestException "I was told to fail"]
let r03 = ValueTask.zipSequentially (e1 ()) (x2 ())
- r03.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
+ r03.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
let r04 = ValueTask.zipSequentially (e1 ()) (e2 ())
- r04.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
-
+ r04.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
+
let r05 = ValueTask.lift2 (mapping2 false) (e1 ()) (x2 ())
- r05.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
+ r05.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
let r06 = ValueTask.lift3 (mapping3 false) (e1 ()) (e2 ()) (e3 ())
- r06.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
+ r06.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
let r07 = ValueTask.lift3 (mapping3 false) (x1 ()) (e2 ()) (e3 ())
- r07.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 2"]
+ r07.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 2"]
let r08 = ValueTask.bind (binding true) (e1 ())
- r08.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
+ r08.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"]
let r09 = ValueTask.bind (binding true) (x1 ())
- r09.AsTask().Exception.InnerExceptions |> areEquivalent [TestException "I was told to fail"]
+ r09.Exception.InnerExceptions |> areEquivalent [TestException "I was told to fail"]
[]
@@ -195,5 +200,736 @@ module ValueTask =
let t123 = ValueTask.map3 (fun x y z -> [x; y; z]) t1 t2 t3
let t123' = transpose [t1; t2; t3]
let t123'' = sequence [t1; t2; t3]
- CollectionAssert.AreEquivalent (t123.AsTask().Exception.InnerExceptions, t123'.AsTask().Exception.InnerExceptions, "ValueTask.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is the same as transpose [t1; t2; t3]")
- CollectionAssert.AreNotEquivalent (t123.AsTask().Exception.InnerExceptions, t123''.AsTask().Exception.InnerExceptions, "ValueTask.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is not the same as sequence [t1; t2; t3]")
+ CollectionAssert.AreEquivalent (t123.Exception.InnerExceptions, t123'.Exception.InnerExceptions, "ValueTask.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is the same as transpose [t1; t2; t3]")
+ CollectionAssert.AreNotEquivalent (t123.Exception.InnerExceptions, t123''.Exception.InnerExceptions, "ValueTask.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is not the same as sequence [t1; t2; t3]")
+
+ module ValueTaskBuilderTests =
+
+ // Same tests, same note as in Task.fs about these tests
+
+ open System.Collections
+ open System.Collections.Generic
+ open System.Diagnostics
+
+ module ValueTask =
+ let Yield () =
+ let ya = Task.Yield().GetAwaiter ()
+ let tcs = TaskCompletionSource TaskCreationOptions.RunContinuationsAsynchronously
+ let k () = tcs.SetResult ()
+ ya.UnsafeOnCompleted (Action k) |> ignore
+ tcs.Task |> ValueTask
+
+ exception TestException of string
+
+ let require x msg = if not x then failwith msg
+
+ let testShortCircuitResult() =
+ let t =
+ monad' {
+ let! x = ValueTask.FromResult(1)
+ let! y = ValueTask.FromResult(2)
+ return x + y
+ }
+ require t.IsCompleted "didn't short-circuit already completed tasks"
+ require (t.Result = 3) "wrong result"
+
+ let testDelay() =
+ let mutable x = 0
+ let t =
+ monad' {
+ do! ValueTask.Delay(50) |> ValueTask.ignore
+ x <- x + 1
+ }
+ require (x = 0) "task already ran"
+ t.Wait()
+
+ let testNoDelay() =
+ let mutable x = 0
+ let t =
+ monad' {
+ x <- x + 1
+ do! ValueTask.Delay(5) |> ValueTask.ignore
+ x <- x + 1
+ }
+ require (x = 1) "first part didn't run yet"
+ t.Wait()
+
+ let testNonBlocking() =
+ let sw = Stopwatch()
+ sw.Start()
+ let t =
+ monad' {
+ do! ValueTask.Yield()
+ Thread.Sleep(100)
+ }
+ sw.Stop()
+ require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller"
+ t.Wait()
+
+ let failtest str = raise (TestException str)
+
+ let testCatching1() =
+ let mutable x = 0
+ let mutable y = 0
+ let t =
+ monad' {
+ try
+ do! ValueTask.Delay(0) |> ValueTask.ignore
+ failtest "hello"
+ x <- 1
+ do! ValueTask.Delay(100) |> ValueTask.ignore
+ with
+ | TestException msg ->
+ require (msg = "hello") "message tampered"
+ | _ ->
+ require false "other exn type"
+ y <- 1
+ }
+ t.Wait()
+ require (y = 1) "bailed after exn"
+ require (x = 0) "ran past failure"
+
+ let testCatching2() =
+ let mutable x = 0
+ let mutable y = 0
+ let t =
+ monad' {
+ try
+ do! ValueTask.Yield() // can't skip through this
+ failtest "hello"
+ x <- 1
+ do! ValueTask.Delay(100) |> ValueTask.ignore
+ with
+ | TestException msg ->
+ require (msg = "hello") "message tampered"
+ | _ ->
+ require false "other exn type"
+ y <- 1
+ }
+ t.Wait()
+ require (y = 1) "bailed after exn"
+ require (x = 0) "ran past failure"
+
+ let testNestedCatching() =
+ let mutable counter = 1
+ let mutable caughtInner = 0
+ let mutable caughtOuter = 0
+ let t1() =
+ monad' {
+ try
+ do! ValueTask.Yield()
+ failtest "hello"
+ with
+ | TestException msg as exn ->
+ caughtInner <- counter
+ counter <- counter + 1
+ raise exn
+ }
+ let t2 =
+ monad' {
+ try
+ do! t1()
+ with
+ | TestException msg as exn ->
+ caughtOuter <- counter
+ raise exn
+ | e ->
+ require false (sprintf "invalid msg type %s" e.Message)
+ }
+ try
+ t2.Wait()
+ require false "ran past failed task wait"
+ with
+ | :? AggregateException as exn ->
+ require (exn.InnerExceptions.Count = 1) "more than 1 exn"
+ require (caughtInner = 1) "didn't catch inner"
+ require (caughtOuter = 2) "didn't catch outer"
+
+ let testTryFinallyHappyPath() =
+ let mutable ran = false
+ let t =
+ monad' {
+ try
+ require (not ran) "ran way early"
+ do! ValueTask.Delay(100) |> ValueTask.ignore
+ require (not ran) "ran kinda early"
+ finally
+ ran <- true
+ }
+ t.Wait()
+ require ran "never ran"
+
+ let testTryFinallySadPath() =
+ let mutable ran = false
+ let t =
+ monad' {
+ try
+ require (not ran) "ran way early"
+ do! ValueTask.Delay(100) |> ValueTask.ignore
+ require (not ran) "ran kinda early"
+ failtest "uhoh"
+ finally
+ ran <- true
+ }
+ try
+ t.Wait()
+ with
+ | :? AggregateException as e ->
+ match e.InnerExceptions |> Seq.toList with
+ | [TestException "uhoh"] -> ()
+ | _ -> raise e
+ | e -> raise e
+ require ran "never ran"
+
+ let testTryFinallyCaught() =
+ let mutable ran = false
+ let t =
+ monad' {
+ try
+ try
+ require (not ran) "ran way early"
+ do! ValueTask.Delay(100) |> ValueTask.ignore
+ require (not ran) "ran kinda early"
+ failtest "uhoh"
+ finally
+ ran <- true
+ return 1
+ with
+ | TestException "uhoh" ->
+ return 2
+ | e ->
+ raise e
+ return 3
+ }
+ require (t.Result = 2) "wrong return"
+ require ran "never ran"
+
+ let testUsing() =
+ let mutable disposed = false
+ let t =
+ monad' {
+ use d = { new IDisposable with member __.Dispose() = disposed <- true }
+ require (not disposed) "disposed way early"
+ do! ValueTask.Delay(100) |> ValueTask.ignore
+ require (not disposed) "disposed kinda early"
+ }
+ t.Wait()
+ require disposed "never disposed"
+
+ let testUsingFromValueTask() =
+ let mutable disposedInner = false
+ let mutable disposed = false
+ let t =
+ monad' {
+ use! d =
+ monad' {
+ do! ValueTask.Delay(50) |> ValueTask.ignore
+ use i = { new IDisposable with member __.Dispose() = disposedInner <- true }
+ require (not disposed && not disposedInner) "disposed inner early"
+ return { new IDisposable with member __.Dispose() = disposed <- true }
+ }
+ require disposedInner "did not dispose inner after task completion"
+ require (not disposed) "disposed way early"
+ do! ValueTask.Delay(50) |> ValueTask.ignore
+ require (not disposed) "disposed kinda early"
+ }
+ t.Wait()
+ require disposed "never disposed"
+
+ let testUsingSadPath() =
+ let mutable disposedInner = false
+ let mutable disposed = false
+ let t =
+ monad' {
+ try
+ use! d =
+ monad' {
+ do! ValueTask.Delay(50) |> ValueTask.ignore
+ use i = { new IDisposable with member __.Dispose() = disposedInner <- true }
+ failtest "uhoh"
+ require (not disposed && not disposedInner) "disposed inner early"
+ return { new IDisposable with member __.Dispose() = disposed <- true }
+ }
+ ()
+ with
+ | TestException msg ->
+ require disposedInner "did not dispose inner after task completion"
+ require (not disposed) "disposed way early"
+ do! ValueTask.Delay(50) |> ValueTask.ignore
+ require (not disposed) "disposed kinda early"
+ }
+ t.Wait()
+ require (not disposed) "disposed thing that never should've existed"
+
+ let testForLoop() =
+ let mutable disposed = false
+ let wrapList =
+ let raw = ["a"; "b"; "c"] |> Seq.ofList
+ let getEnumerator() =
+ let raw = raw.GetEnumerator()
+ { new IEnumerator with
+ member __.MoveNext() =
+ require (not disposed) "moved next after disposal"
+ raw.MoveNext()
+ member __.Current =
+ require (not disposed) "accessed current after disposal"
+ raw.Current
+ member __.Current =
+ require (not disposed) "accessed current (boxed) after disposal"
+ box raw.Current
+ member __.Dispose() =
+ require (not disposed) "disposed twice"
+ disposed <- true
+ raw.Dispose()
+ member __.Reset() =
+ require (not disposed) "reset after disposal"
+ raw.Reset()
+ }
+ { new IEnumerable with
+ member __.GetEnumerator() : IEnumerator = getEnumerator()
+ member __.GetEnumerator() : IEnumerator = upcast getEnumerator()
+ }
+ let t =
+ monad' {
+ let mutable index = 0
+ do! ValueTask.Yield()
+ for x in wrapList do
+ do! ValueTask.Yield()
+ match index with
+ | 0 -> require (x = "a") "wrong first value"
+ | 1 -> require (x = "b") "wrong second value"
+ | 2 -> require (x = "c") "wrong third value"
+ | _ -> require false "iterated too far!"
+ index <- index + 1
+ do! ValueTask.Yield()
+ do! ValueTask.Yield()
+ return 1
+ }
+ t.Wait()
+ require disposed "never disposed"
+
+ let testForLoopSadPath() =
+ let mutable disposed = false
+ let wrapList =
+ let raw = ["a"; "b"; "c"] |> Seq.ofList
+ let getEnumerator() =
+ let raw = raw.GetEnumerator()
+ { new IEnumerator with
+ member __.MoveNext() =
+ require (not disposed) "moved next after disposal"
+ raw.MoveNext()
+ member __.Current =
+ require (not disposed) "accessed current after disposal"
+ raw.Current
+ member __.Current =
+ require (not disposed) "accessed current (boxed) after disposal"
+ box raw.Current
+ member __.Dispose() =
+ require (not disposed) "disposed twice"
+ disposed <- true
+ raw.Dispose()
+ member __.Reset() =
+ require (not disposed) "reset after disposal"
+ raw.Reset()
+ }
+ { new IEnumerable with
+ member __.GetEnumerator() : IEnumerator = getEnumerator()
+ member __.GetEnumerator() : IEnumerator = upcast getEnumerator()
+ }
+ let mutable caught = false
+ let t =
+ monad' {
+ try
+ let mutable index = 0
+ do! ValueTask.Yield()
+ for x in wrapList do
+ do! ValueTask.Yield()
+ match index with
+ | 0 -> require (x = "a") "wrong first value"
+ | _ -> failtest "uhoh"
+ index <- index + 1
+ do! ValueTask.Yield()
+ do! ValueTask.Yield()
+ return 1
+ with
+ | TestException "uhoh" ->
+ caught <- true
+ return 2
+ }
+ require (t.Result = 2) "wrong result"
+ require caught "didn't catch exception"
+ require disposed "never disposed"
+
+ let testExceptionAttachedToValueTaskWithoutAwait() =
+ let mutable ranA = false
+ let mutable ranB = false
+ let t =
+ monad' {
+ ranA <- true
+ do! ValueTask.raise (TestException "uhoh")
+ ranB <- true
+ }
+ require ranA "didn't run immediately"
+ require (not ranB) "ran past exception"
+ require (not (isNull t.Exception)) "didn't capture exception"
+ require (t.Exception.InnerExceptions.Count = 1) "captured more exceptions"
+ require (t.Exception.InnerException = TestException "uhoh") "wrong exception"
+ let mutable caught = false
+ let mutable ranCatcher = false
+ let catcher =
+ monad' {
+ try
+ ranCatcher <- true
+ let! result = t
+ return false
+ with
+ | TestException "uhoh" ->
+ caught <- true
+ return true
+ }
+ require ranCatcher "didn't run"
+ require catcher.Result "didn't catch"
+ require caught "didn't catch"
+
+ let testExceptionAttachedToValueTaskWithAwait() =
+ let mutable ranA = false
+ let mutable ranB = false
+ let t =
+ monad' {
+ ranA <- true
+ do! ValueTask.raise (TestException "uhoh")
+ do! ValueTask.Delay(100) |> ValueTask.ignore
+ ranB <- true
+ }
+ require ranA "didn't run immediately"
+ require (not ranB) "ran past exception"
+ require (not (isNull t.Exception)) "didn't capture exception"
+ require (t.Exception.InnerExceptions.Count = 1) "captured more exceptions"
+ require (t.Exception.InnerException = TestException "uhoh") "wrong exception"
+ let mutable caught = false
+ let mutable ranCatcher = false
+ let catcher =
+ monad' {
+ try
+ ranCatcher <- true
+ let! result = t
+ return false
+ with
+ | TestException "uhoh" ->
+ caught <- true
+ return true
+ }
+ require ranCatcher "didn't run"
+ require catcher.Result "didn't catch"
+ require caught "didn't catch"
+
+ let testExceptionThrownInFinally() =
+ let mutable ranInitial = false
+ let mutable ranNext = false
+ let mutable ranFinally = 0
+ let t =
+ monad' {
+ try
+ ranInitial <- true
+ do! ValueTask.Yield()
+ Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes
+ ranNext <- true
+ finally
+ ranFinally <- ranFinally + 1
+ failtest "finally exn!"
+ }
+ require ranInitial "didn't run initial"
+ require (not ranNext) "ran next too early"
+ try
+ t.Wait()
+ require false "shouldn't get here"
+ with
+ | _ -> ()
+ require ranNext "didn't run next"
+ require (ranFinally = 1) "didn't run finally exactly once"
+
+ let test2ndExceptionThrownInFinally() =
+ let mutable ranInitial = false
+ let mutable ranNext = false
+ let mutable ranFinally = 0
+ let t =
+ monad' {
+ try
+ ranInitial <- true
+ do! ValueTask.Yield()
+ Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes
+ ranNext <- true
+ failtest "uhoh"
+ finally
+ ranFinally <- ranFinally + 1
+ failtest "2nd exn!"
+ }
+ require ranInitial "didn't run initial"
+ require (not ranNext) "ran next too early"
+ try
+ t.Wait()
+ require false "shouldn't get here"
+ with
+ | _ -> ()
+ require ranNext "didn't run next"
+ require (ranFinally = 1) "didn't run finally exactly once"
+
+ let testFixedStackWhileLoop() =
+ let bigNumber = 10000
+ let t =
+ monad' {
+ let mutable maxDepth = Nullable()
+ let mutable i = 0
+ while i < bigNumber do
+ i <- i + 1
+ do! ValueTask.Yield()
+ if i % 100 = 0 then
+ let stackDepth = StackTrace().FrameCount
+ if maxDepth.HasValue && stackDepth > maxDepth.Value then
+ failwith "Stack depth increased!"
+ maxDepth <- Nullable(stackDepth)
+ return i
+ }
+ t.Wait()
+ require (t.Result = bigNumber) "didn't get to big number"
+
+ let testFixedStackForLoop() =
+ let bigNumber = 10000
+ let mutable ran = false
+ let t =
+ monad' {
+ let mutable maxDepth = Nullable()
+ for i in Seq.init bigNumber id do
+ do! ValueTask.Yield()
+ if i % 100 = 0 then
+ let stackDepth = StackTrace().FrameCount
+ if maxDepth.HasValue && stackDepth > maxDepth.Value then
+ failwith "Stack depth increased!"
+ maxDepth <- Nullable(stackDepth)
+ ran <- true
+ return ()
+ }
+ t.Wait()
+ require ran "didn't run all"
+
+ let testTypeInference() =
+ let t1 : string ValueTask =
+ monad' {
+ return "hello"
+ }
+ let t2 =
+ monad' {
+ let! s = t1
+ return s.Length
+ }
+ t2.Wait()
+
+ let testNoStackOverflowWithImmediateResult() =
+ let longLoop =
+ monad' {
+ let mutable n = 0
+ while n < 10_000 do
+ n <- n + 1
+ return! ValueTask.FromResult(())
+ }
+ longLoop.Wait()
+
+ let testNoStackOverflowWithYieldResult() =
+ let longLoop =
+ monad' {
+ let mutable n = 0
+ while n < 10_000 do
+ let! _ =
+ monad' {
+ do! ValueTask.Yield()
+ let! _ = ValueTask.FromResult(0)
+ n <- n + 1
+ }
+ n <- n + 1
+ }
+ longLoop.Wait()
+
+ let testSmallTailRecursion() =
+ let shortLoop =
+ monad' {
+ let rec loop n =
+ monad' {
+ // larger N would stack overflow on Mono, eat heap mem on MS .NET
+ if n < 1000 then
+ do! ValueTask.Yield()
+ let! _ = ValueTask.FromResult(0)
+ return! loop (n + 1)
+ else
+ return ()
+ }
+ return! loop 0
+ }
+ shortLoop.Wait()
+
+ let testTryOverReturnFrom() =
+ let inner() =
+ monad' {
+ do! ValueTask.Yield()
+ failtest "inner"
+ return 1
+ }
+ let t =
+ monad' {
+ try
+ do! ValueTask.Yield()
+ return! inner()
+ with
+ | TestException "inner" -> return 2
+ }
+ require (t.Result = 2) "didn't catch"
+
+ let testTryFinallyOverReturnFromWithException() =
+ let inner() =
+ monad' {
+ do! ValueTask.Yield()
+ failtest "inner"
+ return 1
+ }
+ let mutable m = 0
+ let t =
+ monad' {
+ try
+ do! ValueTask.Yield()
+ return! inner()
+ finally
+ m <- 1
+ }
+ try
+ t.Wait()
+ with
+ | :? AggregateException -> ()
+ require (m = 1) "didn't run finally"
+
+ let testTryFinallyOverReturnFromWithoutException() =
+ let inner() =
+ monad' {
+ do! ValueTask.Yield()
+ return 1
+ }
+ let mutable m = 0
+ let t =
+ monad' {
+ try
+ do! ValueTask.Yield()
+ return! inner()
+ finally
+ m <- 1
+ }
+ try
+ t.Wait()
+ with
+ | :? AggregateException -> ()
+ require (m = 1) "didn't run finally"
+
+ // no need to call this, we just want to check that it compiles w/o warnings
+ let testTrivialReturnCompiles (x : 'a) : 'a ValueTask =
+ monad' {
+ do! ValueTask.Yield()
+ return x
+ }
+
+ // no need to call this, we just want to check that it compiles w/o warnings
+ let testTrivialTransformedReturnCompiles (x : 'a) (f : 'a -> 'b) : 'b ValueTask =
+ monad' {
+ do! ValueTask.Yield()
+ return f x
+ }
+
+ type IValueTaskThing =
+ abstract member ValueTaskify : 'a option -> 'a ValueTask
+
+ // no need to call this, we just want to check that it compiles w/o warnings
+ let testInterfaceUsageCompiles (iface : IValueTaskThing) (x : 'a) : 'a ValueTask =
+ monad' {
+ let! xResult = iface.ValueTaskify (Some x)
+ do! ValueTask.Yield()
+ return xResult
+ }
+
+ let testAsyncsMixedWithValueTasks() =
+ let t =
+ monad' {
+ do! ValueTask.Delay(1) |> ValueTask.ignore
+ do! Async.Sleep(1) |> Async.StartAsValueTask
+ let! x =
+ async {
+ do! Async.Sleep(1)
+ return 5
+ } |> Async.StartAsValueTask
+ return! async { return x + 3 } |> Async.StartAsValueTask
+ }
+ let result = t.Result
+ require (result = 8) "something weird happened"
+
+ // no need to call this, we just want to check that it compiles w/o warnings
+ let testDefaultInferenceForReturnFrom() =
+ // NOTE the type hint is due to https://github.com/dotnet/fsharp/issues/12929
+ let t: ValueTask = monad' { return Some "x" }
+ monad' {
+ let! r = t
+ if r = None then
+ return! failwithf "Could not find x"
+ else
+ return r
+ }
+
+ // no need to call this, just check that it compiles
+ let testCompilerInfersArgumentOfReturnFrom : ValueTask<_> =
+ monad' {
+ if true then return 1
+ else return! failwith ""
+ }
+
+ []
+ let taskbuilderTests () =
+ printfn "Running taskbuilder tests..."
+ try
+ testShortCircuitResult()
+ testDelay()
+ testNoDelay()
+ testNonBlocking()
+ testCatching1()
+ testCatching2()
+ testNestedCatching()
+ testTryFinallyHappyPath()
+ testTryFinallySadPath()
+ testTryFinallyCaught()
+ testUsing()
+ testUsingFromValueTask()
+ testUsingSadPath()
+ testForLoop()
+ testForLoopSadPath()
+ testExceptionAttachedToValueTaskWithoutAwait() // *1
+ testExceptionAttachedToValueTaskWithAwait() // *1
+ testExceptionThrownInFinally()
+ test2ndExceptionThrownInFinally()
+ testFixedStackWhileLoop() // *2
+ testFixedStackForLoop() // *2
+ testTypeInference()
+ // testNoStackOverflowWithImmediateResult() // *3
+ testNoStackOverflowWithYieldResult()
+ // (Original note from ValueTaskBuilder, n/a here)
+ // we don't support TCO, so large tail recursions will stack overflow
+ // or at least use O(n) heap. but small ones should at least function OK.
+ testSmallTailRecursion()
+ testTryOverReturnFrom()
+ testTryFinallyOverReturnFromWithException()
+ testTryFinallyOverReturnFromWithoutException()
+ // testCompatibilityWithOldUnitValueTask() // *4
+ testAsyncsMixedWithValueTasks() // *5
+ printfn "Passed all tests!"
+ with
+ | exn ->
+ eprintfn "Exception: %O" exn
+ ()
+
+ // *1 Test adapted due to errors not being part of the workflow, this is by-design.
+ // *2 Fails if run multiple times with System.Exception: Stack depth increased!
+ // *3 Fails with Stack Overflow.
+ // *4 Not applicable.
+ // *5 Test adapted due to Async not being automatically converted, this is by-design.