From c62ccfbca13f052b05160a35f3a1945c23a515f9 Mon Sep 17 00:00:00 2001 From: jchassaing Date: Wed, 15 Feb 2023 16:31:33 +0100 Subject: [PATCH] Feat: Implement builder for valuetask --- src/FSharp.Core/FSharp.Core.fsproj | 6 + src/FSharp.Core/fslib-extra-pervasives.fs | 5 + src/FSharp.Core/valuetasks.fs | 478 ++++++ src/FSharp.Core/valuetasks.fsi | 284 ++++ .../FSharp.Core.UnitTests.fsproj | 2 + .../Microsoft.FSharp.Control/ValueTasks.fs | 1352 +++++++++++++++++ .../ValueTasksDynamic.fs | 1310 ++++++++++++++++ 7 files changed, 3437 insertions(+) create mode 100644 src/FSharp.Core/valuetasks.fs create mode 100644 src/FSharp.Core/valuetasks.fsi create mode 100644 tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/ValueTasks.fs create mode 100644 tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/ValueTasksDynamic.fs diff --git a/src/FSharp.Core/FSharp.Core.fsproj b/src/FSharp.Core/FSharp.Core.fsproj index f490c9cccfb..a91c4d78d6d 100644 --- a/src/FSharp.Core/FSharp.Core.fsproj +++ b/src/FSharp.Core/FSharp.Core.fsproj @@ -204,6 +204,12 @@ Control/tasks.fs + + Control/valuetasks.fsi + + + Control/valuetasks.fs + Control/eventmodule.fsi diff --git a/src/FSharp.Core/fslib-extra-pervasives.fs b/src/FSharp.Core/fslib-extra-pervasives.fs index 234b4fdb8fe..2bee0ceb540 100644 --- a/src/FSharp.Core/fslib-extra-pervasives.fs +++ b/src/FSharp.Core/fslib-extra-pervasives.fs @@ -330,6 +330,11 @@ module ExtraTopLevelOperators = [] [] [] +#if NETSTANDARD2_1 + [] + [] + [] +#endif [] [] do () diff --git a/src/FSharp.Core/valuetasks.fs b/src/FSharp.Core/valuetasks.fs new file mode 100644 index 00000000000..87e7aa2d1b8 --- /dev/null +++ b/src/FSharp.Core/valuetasks.fs @@ -0,0 +1,478 @@ +// ValueTask builder for F# that compiles to allocation-free paths for synchronous code. +// +// Originally written in 2016 by Robert Peele (humbobst@gmail.com) +// New operator-based overload resolution for F# 4.0 compatibility by Gustavo Leon in 2018. +// Revised for insertion into FSharp.Core by Microsoft, 2019. +// +// Original notice: +// To the extent possible under law, the author(s) have dedicated all copyright and related and neighboring rights +// to this software to the public domain worldwide. This software is distributed without any warranty. +// +// Updates: +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.FSharp.Control +#if NETSTANDARD2_1 + +open System +open System.Runtime.CompilerServices +open System.Threading +open System.Threading.Tasks +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.CompilerServices +open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Control +open Microsoft.FSharp.Collections + +/// The extra data stored in ResumableStateMachine for valuetasks +[] +type ValueTaskStateMachineData<'T> = + + [] + val mutable Result: 'T + + [] + val mutable MethodBuilder: AsyncValueTaskMethodBuilder<'T> + +and ValueTaskStateMachine<'TOverall> = ResumableStateMachine> +and ValueTaskResumptionFunc<'TOverall> = ResumptionFunc> +and ValueTaskResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> +and ValueTaskCode<'TOverall, 'T> = ResumableCode, 'T> + +type ValueTaskBuilderBase() = + + member inline _.Delay(generator: unit -> ValueTaskCode<'TOverall, 'T>) : ValueTaskCode<'TOverall, 'T> = + ValueTaskCode<'TOverall, 'T>(fun sm -> (generator ()).Invoke(&sm)) + + /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. + [] + member inline _.Zero() : ValueTaskCode<'TOverall, unit> = + ResumableCode.Zero() + + member inline _.Return(value: 'T) : ValueTaskCode<'T, 'T> = + ValueTaskCode<'T, _>(fun sm -> + sm.Data.Result <- value + true) + + /// Chains together a step with its following step. + /// Note that this requires that the first step has no result. + /// This prevents constructs like `task { return 1; return 2; }`. + member inline _.Combine + ( + task1: ValueTaskCode<'TOverall, unit>, + task2: ValueTaskCode<'TOverall, 'T> + ) : ValueTaskCode<'TOverall, 'T> = + ResumableCode.Combine(task1, task2) + + /// Builds a step that executes the body while the condition predicate is true. + member inline _.While + ( + [] condition: unit -> bool, + body: ValueTaskCode<'TOverall, unit> + ) : ValueTaskCode<'TOverall, unit> = + ResumableCode.While(condition, body) + + /// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function + /// to retrieve the step, and in the continuation of the step (if any). + member inline _.TryWith + ( + body: ValueTaskCode<'TOverall, 'T>, + catch: exn -> ValueTaskCode<'TOverall, 'T> + ) : ValueTaskCode<'TOverall, 'T> = + ResumableCode.TryWith(body, catch) + + /// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function + /// to retrieve the step, and in the continuation of the step (if any). + member inline _.TryFinally + ( + body: ValueTaskCode<'TOverall, 'T>, + [] compensation: unit -> unit + ) : ValueTaskCode<'TOverall, 'T> = + ResumableCode.TryFinally( + body, + ResumableCode<_, _>(fun _sm -> + compensation () + true) + ) + + member inline _.For + ( + sequence: seq<'T>, + body: 'T -> ValueTaskCode<'TOverall, unit> + ) : ValueTaskCode<'TOverall, unit> = + ResumableCode.For(sequence, body) + +#if NETSTANDARD2_1 + member inline internal this.TryFinallyAsync + ( + body: ValueTaskCode<'TOverall, 'T>, + compensation: unit -> ValueTask + ) : ValueTaskCode<'TOverall, 'T> = + ResumableCode.TryFinallyAsync( + body, + ResumableCode<_, _>(fun sm -> + if __useResumableCode then + let mutable __stack_condition_fin = true + let __stack_vtask = compensation () + + if not __stack_vtask.IsCompleted then + let mutable awaiter = __stack_vtask.GetAwaiter() + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_condition_fin <- __stack_yield_fin + + if not __stack_condition_fin then + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + + __stack_condition_fin + else + let vtask = compensation () + let mutable awaiter = vtask.GetAwaiter() + + let cont = + ValueTaskResumptionFunc<'TOverall>(fun sm -> + awaiter.GetResult() |> ignore + true) + + // shortcut to continue immediately + if awaiter.IsCompleted then + true + else + sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion) + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false) + ) + + member inline this.Using<'Resource, 'TOverall, 'T when 'Resource :> IAsyncDisposable> + ( + resource: 'Resource, + body: 'Resource -> ValueTaskCode<'TOverall, 'T> + ) : ValueTaskCode<'TOverall, 'T> = + this.TryFinallyAsync( + (fun sm -> (body resource).Invoke(&sm)), + (fun () -> + if not (isNull (box resource)) then + resource.DisposeAsync() + else + ValueTask()) + ) +#endif + +type ValueTaskBuilder() = + + inherit ValueTaskBuilderBase() + + // This is the dynamic implementation - this is not used + // for statically compiled tasks. An executor (resumptionFuncExecutor) is + // registered with the state machine, plus the initial resumption. + // The executor stays constant throughout the execution, it wraps each step + // of the execution in a try/with. The resumption is changed at each step + // to represent the continuation of the computation. + static member RunDynamic(code: ValueTaskCode<'T, 'T>) : ValueTask<'T> = + let mutable sm = ValueTaskStateMachine<'T>() + let initialResumptionFunc = ValueTaskResumptionFunc<'T>(fun sm -> code.Invoke(&sm)) + + let resumptionInfo = + { new ValueTaskResumptionDynamicInfo<'T>(initialResumptionFunc) with + member info.MoveNext(sm) = + let mutable savedExn = null + + try + sm.ResumptionDynamicInfo.ResumptionData <- null + let step = info.ResumptionFunc.Invoke(&sm) + + if step then + sm.Data.MethodBuilder.SetResult(sm.Data.Result) + else + let mutable awaiter = + sm.ResumptionDynamicInfo.ResumptionData :?> ICriticalNotifyCompletion + + assert not (isNull awaiter) + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + + with exn -> + savedExn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match savedExn with + | null -> () + | exn -> sm.Data.MethodBuilder.SetException exn + + member _.SetStateMachine(sm, state) = + sm.Data.MethodBuilder.SetStateMachine(state) + } + + sm.ResumptionDynamicInfo <- resumptionInfo + sm.Data.MethodBuilder <- AsyncValueTaskMethodBuilder<'T>.Create () + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + + member inline _.Run(code: ValueTaskCode<'T, 'T>) : ValueTask<'T> = + if __useResumableCode then + __stateMachine, ValueTask<'T>> + (MoveNextMethodImpl<_>(fun sm -> + //-- RESUMABLE CODE START + __resumeAt sm.ResumptionPoint + let mutable __stack_exn: Exception = null + + try + let __stack_code_fin = code.Invoke(&sm) + + if __stack_code_fin then + sm.Data.MethodBuilder.SetResult(sm.Data.Result) + with exn -> + __stack_exn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match __stack_exn with + | null -> () + | exn -> sm.Data.MethodBuilder.SetException exn + //-- RESUMABLE CODE END + )) + (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine(state))) + (AfterCode<_, _>(fun sm -> + sm.Data.MethodBuilder <- AsyncValueTaskMethodBuilder<'T>.Create () + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task)) + else + ValueTaskBuilder.RunDynamic(code) + +module ValueTaskBuilder = + + let valuetask = ValueTaskBuilder() + +namespace Microsoft.FSharp.Control.ValueTaskBuilderExtensions + +open Microsoft.FSharp.Control +open System +open System.Runtime.CompilerServices +open System.Threading.Tasks +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.CompilerServices +open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators + +module LowPriority = + // Low priority extensions + type ValueTaskBuilderBase with + + [] + static member inline BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'TResult1)> + ( + sm: byref<_>, + task: ^TaskLike, + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) + ) : bool = + + let mutable awaiter = (^TaskLike: (member GetAwaiter: unit -> ^Awaiter) (task)) + + let cont = + (ValueTaskResumptionFunc<'TOverall>(fun sm -> + let result = (^Awaiter: (member GetResult: unit -> 'TResult1) (awaiter)) + (continuation result).Invoke(&sm))) + + // shortcut to continue immediately + if (^Awaiter: (member get_IsCompleted: unit -> bool) (awaiter)) then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion) + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + [] + member inline _.Bind< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'TResult1)> + ( + task: ^TaskLike, + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) + ) : ValueTaskCode<'TOverall, 'TResult2> = + + ValueTaskCode<'TOverall, _>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + // Get an awaiter from the awaitable + let mutable awaiter = (^TaskLike: (member GetAwaiter: unit -> ^Awaiter) (task)) + + let mutable __stack_fin = true + + if not (^Awaiter: (member get_IsCompleted: unit -> bool) (awaiter)) then + // This will yield with __stack_yield_fin = false + // This will resume with __stack_yield_fin = true + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_fin <- __stack_yield_fin + + if __stack_fin then + let result = (^Awaiter: (member GetResult: unit -> 'TResult1) (awaiter)) + (continuation result).Invoke(&sm) + else + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + false + else + ValueTaskBuilderBase.BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall>( + &sm, + task, + continuation + ) + //-- RESUMABLE CODE END + ) + + [] + member inline this.ReturnFrom< ^TaskLike, ^Awaiter, 'T + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'T)> + (task: ^TaskLike) + : ValueTaskCode<'T, 'T> = + + this.Bind(task, (fun v -> this.Return v)) + + member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposable> + ( + resource: 'Resource, + body: 'Resource -> ValueTaskCode<'TOverall, 'T> + ) = + ResumableCode.Using(resource, body) + +module HighPriority = + // High priority extensions + type ValueTaskBuilderBase with + + static member BindDynamic + ( + sm: byref<_>, + task: ValueTask<'TResult1>, + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) + ) : bool = + // let mutable awaiter = task.GetAwaiter() + + let cont = + (ValueTaskResumptionFunc<'TOverall>(fun sm -> + let result = task.Result + (continuation result).Invoke(&sm))) + + // shortcut to continue immediately + if task.IsCompleted then + cont.Invoke(&sm) + else + let mutable awaiter = task.GetAwaiter() + sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion) + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + member inline _.Bind + ( + task: ValueTask<'TResult1>, + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) + ) : ValueTaskCode<'TOverall, 'TResult2> = + + ValueTaskCode<'TOverall, _>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + // Get an awaiter from the task + + let mutable __stack_fin = true + + if not task.IsCompleted then + // This will yield with __stack_yield_fin = false + // This will resume with __stack_yield_fin = true + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_fin <- __stack_yield_fin + + if __stack_fin then + let result = task.Result + (continuation result).Invoke(&sm) + else if task.IsCompletedSuccessfully then + (continuation task.Result).Invoke(&sm) + else + let mutable awaiter = task.GetAwaiter() + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + false + else + ValueTaskBuilderBase.BindDynamic(&sm, task, continuation) + //-- RESUMABLE CODE END + ) + + member inline this.ReturnFrom(task: ValueTask<'T>) : ValueTaskCode<'T, 'T> = + this.Bind(task, (fun v -> this.Return v)) + +module MediumPriority = + open HighPriority + + // Medium priority extensions + type ValueTaskBuilderBase with + + static member BindDynamic + ( + sm: byref<_>, + task: Task<'TResult1>, + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) + ) : bool = + // let mutable awaiter = task.GetAwaiter() + + let cont = + (ValueTaskResumptionFunc<'TOverall>(fun sm -> + let result = task.Result + (continuation result).Invoke(&sm))) + + // shortcut to continue immediately + if task.IsCompleted then + cont.Invoke(&sm) + else + let mutable awaiter = task.GetAwaiter() + sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion) + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + member inline _.Bind + ( + task: Task<'TResult1>, + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) + ) : ValueTaskCode<'TOverall, 'TResult2> = + + ValueTaskCode<'TOverall, _>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + // Get an awaiter from the task + + let mutable __stack_fin = true + + if not task.IsCompleted then + // This will yield with __stack_yield_fin = false + // This will resume with __stack_yield_fin = true + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_fin <- __stack_yield_fin + + if __stack_fin then + let result = task.Result + (continuation result).Invoke(&sm) + else if task.IsCompletedSuccessfully then + (continuation task.Result).Invoke(&sm) + else + let mutable awaiter = task.GetAwaiter() + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + false + else + ValueTaskBuilderBase.BindDynamic(&sm, task, continuation) + //-- RESUMABLE CODE END + ) + + member inline this.ReturnFrom(task: Task<'T>) : ValueTaskCode<'T, 'T> = + this.Bind(task, (fun v -> this.Return v)) + + member inline this.Bind + ( + computation: Async<'TResult1>, + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) + ) : ValueTaskCode<'TOverall, 'TResult2> = + this.Bind(ValueTask<'TResult1>(Async.StartImmediateAsTask computation), continuation) + + member inline this.ReturnFrom(computation: Async<'T>) : ValueTaskCode<'T, 'T> = + this.ReturnFrom(ValueTask<'T>(Async.StartImmediateAsTask computation)) + +#endif diff --git a/src/FSharp.Core/valuetasks.fsi b/src/FSharp.Core/valuetasks.fsi new file mode 100644 index 00000000000..46c977f9842 --- /dev/null +++ b/src/FSharp.Core/valuetasks.fsi @@ -0,0 +1,284 @@ +// ValueTaskBuilder.fs - TPL value task computation expressions for F# +// +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +namespace Microsoft.FSharp.Control + +#if !BUILDING_WITH_LKG && !BUILD_FROM_SOURCE && NETSTANDARD2_1 +open System +open System.Runtime.CompilerServices +open System.Threading.Tasks +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.CompilerServices +open Microsoft.FSharp.Collections + +/// +/// The extra data stored in ResumableStateMachine for valuetasks +/// +[] +[] +[] +type ValueTaskStateMachineData<'T> = + + /// + /// Holds the final result of the state machine + /// + [] + val mutable Result: 'T + + /// + /// Holds the MethodBuilder for the state machine + /// + [] + val mutable MethodBuilder: AsyncValueTaskMethodBuilder<'T> + +/// +/// This is used by the compiler as a template for creating state machine structs +/// +and [] ValueTaskStateMachine<'TOverall> = + ResumableStateMachine> + +/// +/// Represents the runtime continuation of a valuetask state machine created dynamically +/// +and [] ValueTaskResumptionFunc<'TOverall> = + ResumptionFunc> + +/// +/// A special compiler-recognised delegate type for specifying blocks of valuetask code +/// with access to the state machine. +/// +and [] ValueTaskCode<'TOverall, 'T> = + ResumableCode, 'T> + +/// +/// Contains methods to build valuetasks using the F# computation expression syntax +/// +[] +type ValueTaskBuilderBase = + + /// + /// Specifies the sequential composition of two units of valuetask code. + /// + member inline Combine: + task1: ValueTaskCode<'TOverall, unit> * task2: ValueTaskCode<'TOverall, 'T> -> ValueTaskCode<'TOverall, 'T> + + /// + /// Specifies the delayed execution of a unit of valuetask code. + /// + member inline Delay: generator: (unit -> ValueTaskCode<'TOverall, 'T>) -> ValueTaskCode<'TOverall, 'T> + + /// + /// Specifies the iterative execution of a unit of valuetask code. + /// + member inline For: + sequence: seq<'T> * body: ('T -> ValueTaskCode<'TOverall, unit>) -> ValueTaskCode<'TOverall, unit> + + /// + /// Specifies a unit of valuetask code which returns a value + /// + member inline Return: value: 'T -> ValueTaskCode<'T, 'T> + + /// + /// Specifies a unit of valuetask code which excuted using try/finally semantics + /// + member inline TryFinally: + body: ValueTaskCode<'TOverall, 'T> * [] compensation: (unit -> unit) -> + ValueTaskCode<'TOverall, 'T> + + /// + /// Specifies a unit of valuetask code which excuted using try/with semantics + /// + member inline TryWith: + body: ValueTaskCode<'TOverall, 'T> * catch: (exn -> ValueTaskCode<'TOverall, 'T>) -> + ValueTaskCode<'TOverall, 'T> + + /// + /// Specifies a unit of valuetask code which binds to the resource implementing IAsyncDisposable and disposes it asynchronously + /// + member inline Using<'Resource, 'TOverall, 'T when 'Resource :> IAsyncDisposable> : + resource: 'Resource * body: ('Resource -> ValueTaskCode<'TOverall, 'T>) -> ValueTaskCode<'TOverall, 'T> + + /// + /// Specifies the iterative execution of a unit of valuetask code. + /// + member inline While: + condition: (unit -> bool) * body: ValueTaskCode<'TOverall, unit> -> ValueTaskCode<'TOverall, unit> + + /// + /// Specifies a unit of valuetask code which produces no result + /// + [] + member inline Zero: unit -> ValueTaskCode<'TOverall, unit> + +/// +/// Contains methods to build tasks using the F# computation expression syntax +/// +[] +type ValueTaskBuilder = + inherit ValueTaskBuilderBase + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve valuetasks or other reflective execution of F# code. + /// + static member RunDynamic: code: ValueTaskCode<'T, 'T> -> ValueTask<'T> + + /// Hosts the valuetask code in a state machine and starts the valuetask. + member inline Run: code: ValueTaskCode<'T, 'T> -> ValueTask<'T> + +/// Contains the `valuetask` computation expression builder. +[] +module ValueTaskBuilder = + + /// + /// Builds a valuetask using computation expression syntax. + /// + /// + /// + val valuetask: ValueTaskBuilder + +// Contains the `valuetask` computation expression builder. +namespace Microsoft.FSharp.Control.ValueTaskBuilderExtensions + +open System +open System.Runtime.CompilerServices +open System.Threading.Tasks +open Microsoft.FSharp.Core +open Microsoft.FSharp.Control +open Microsoft.FSharp.Core.CompilerServices + +/// +/// Contains low-priority overloads for the `valuetask` computation expression builder. +/// +// +// Note: they are low priority because they are auto-opened first, and F# has a rule +// that extension method opened later in sequence get higher priority +// +// AutoOpen is by assembly attribute to get sequencing of AutoOpen correct and +// so each gives different priority +module LowPriority = + + type ValueTaskBuilderBase with + + /// + /// Specifies a unit of valuetask code which draws a result from a task-like value + /// satisfying the GetAwaiter pattern and calls a continuation. + /// + [] + member inline Bind< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall> : + task: ^TaskLike * continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) -> + ValueTaskCode<'TOverall, 'TResult2> + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'TResult1) + + /// + /// Specifies a unit of valuetask code which draws its result from a task-like value + /// satisfying the GetAwaiter pattern. + /// + [] + member inline ReturnFrom< ^TaskLike, ^Awaiter, 'T> : + task: ^TaskLike -> ValueTaskCode<'T, 'T> + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'T) + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve tasks or other reflective execution of F# code. + /// + [] + static member inline BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall> : + sm: byref> * + task: ^TaskLike * + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) -> + bool + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'TResult1) + + /// + /// Specifies a unit of valuetask code which binds to the resource implementing IDisposable and disposes it synchronously + /// + member inline Using: + resource: 'Resource * body: ('Resource -> ValueTaskCode<'TOverall, 'T>) -> ValueTaskCode<'TOverall, 'T> + when 'Resource :> IDisposable + +/// +/// Contains medium-priority overloads for the `valuetask` computation expression builder. +/// +module MediumPriority = + + type ValueTaskBuilderBase with + + /// + /// Specifies a unit of valuetask code which draws a result from an F# async value then calls a continuation. + /// + member inline Bind: + computation: Async<'TResult1> * continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) -> + ValueTaskCode<'TOverall, 'TResult2> + + /// + /// Specifies a unit of task code which draws a result from an F# async value. + /// + member inline ReturnFrom: computation: Async<'T> -> ValueTaskCode<'T, 'T> + + /// + /// Specifies a unit of valuetask code which draws a result from a task then calls a continuation. + /// + member inline Bind: + task: Task<'TResult1> * continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) -> + ValueTaskCode<'TOverall, 'TResult2> + + /// + /// Specifies a unit of valuetask code which draws a result from a task. + /// + member inline ReturnFrom: task: Task<'T> -> ValueTaskCode<'T, 'T> + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve tasks or other reflective execution of F# code. + /// + static member BindDynamic: + sm: byref> * + task: Task<'TResult1> * + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) -> + bool + +/// +/// Contains high-priority overloads for the `valuetask` computation expression builder. +/// +module HighPriority = + + type ValueTaskBuilderBase with + + /// + /// Specifies a unit of valuetask code which draws a result from a valuetask then calls a continuation. + /// + member inline Bind: + task: ValueTask<'TResult1> * continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) -> + ValueTaskCode<'TOverall, 'TResult2> + + /// + /// Specifies a unit of valuetask code which draws a result from a valuetask. + /// + member inline ReturnFrom: task: ValueTask<'T> -> ValueTaskCode<'T, 'T> + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve valuetasks or other reflective execution of F# code. + /// + static member BindDynamic: + sm: byref> * + task: ValueTask<'TResult1> * + continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>) -> + bool + +#endif diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj b/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj index 9d0db234965..573c3b33365 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj @@ -84,6 +84,8 @@ + + diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/ValueTasks.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/ValueTasks.fs new file mode 100644 index 00000000000..cb00d65409f --- /dev/null +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/ValueTasks.fs @@ -0,0 +1,1352 @@ +// Tests for TaskBuilder.fs +// +// Written in 2016 by Robert Peele (humbobst@gmail.com) +// +// To the extent possible under law, the author(s) have dedicated all copyright and related and neighboring rights +// to this software to the public domain worldwide. This software is distributed without any warranty. +// +// You should have received a copy of the CC0 Public Domain Dedication along with this software. +// If not, see . + + +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +// Various tests for the: +// Microsoft.FSharp.Control.Async type + +namespace FSharp.Core.UnitTests.Control.ValueTasks +#if NETCOREAPP +open System +open System.Collections +open System.Collections.Generic +open System.Diagnostics +open System.Threading +open System.Threading.Tasks +open Microsoft.FSharp.Control +#if STANDALONE +[] +type FactAttribute() = inherit Attribute() +#else +open Xunit +#endif + + +type ITaskThing = + abstract member Taskify : 'a option -> 'a ValueTask + +[] +module ValueTask = + let unitvaluetask (task: ValueTask) : ValueTask = + if task.IsCompleted then + ValueTask.CompletedTask + else + task.AsTask() |> ValueTask + + let wait (task: ValueTask<'t>) = + if not task.IsCompleted then + task.AsTask().Wait() + +type SupportBothDisposables() = + let mutable called = false + + interface IAsyncDisposable with + member __.DisposeAsync() = + valuetask { + System.Console.WriteLine "incrementing" + called <- true } |> unitvaluetask + interface IDisposable with + member __.Dispose() = failwith "dispose" + member x.Disposed = called + +type SmokeTestsForCompilation() = + + [] + member __.tinyTask() = + valuetask { + return 1 + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + [] + member __.tbind() = + valuetask { + let! x = ValueTask.FromResult(1) + return 1 + x + } + |> fun t -> + wait t + if t.Result <> 2 then failwith "failed" + + [] + member __.tnested() = + valuetask { + let! x = valuetask { return 1 } + return x + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + [] + member __.tcatch0() = + valuetask { + try + return 1 + with e -> + return 2 + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + [] + member __.tcatch1() = + valuetask { + try + let! x = ValueTask.FromResult 1 + return x + with e -> + return 2 + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + + [] + member __.t3() = + let t2() = + valuetask { + System.Console.WriteLine("hello") + return 1 + } + valuetask { + System.Console.WriteLine("hello") + let! x = t2() + System.Console.WriteLine("world") + return 1 + x + } + |> fun t -> + wait t + if t.Result <> 2 then failwith "failed" + + [] + member __.t3b() = + valuetask { + System.Console.WriteLine("hello") + let! x = Task.FromResult(1) + System.Console.WriteLine("world") + return 1 + x + } + |> fun t -> + wait t + if t.Result <> 2 then failwith "failed" + + [] + member __.t3c() = + valuetask { + System.Console.WriteLine("hello") + do! Task.Delay(100) + System.Console.WriteLine("world") + return 1 + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + [] + // This tests an exception match + member __.t67() = + valuetask { + try + do! Task.Delay(0) + with + | :? ArgumentException -> + () + | _ -> + () + } + |> fun t -> + wait t + if t.Result <> () then failwith "failed" + + [] + // This tests compiling an incomplete exception match + member __.t68() = + valuetask { + try + do! Task.Delay(0) + with + | :? ArgumentException -> + () + } + |> fun t -> + wait t + if t.Result <> () then failwith "failed" + + [] + member __.testCompileAsyncWhileLoop() = + valuetask { + let mutable i = 0 + while i < 5 do + i <- i + 1 + do! Task.Yield() + return i + } + |> fun t -> + wait t + if t.Result <> 5 then failwith "failed" + +exception TestException of string + +[] +module Helpers = + let BIG = 10 + // let BIG = 10000 + let require x msg = if not x then failwith msg + let failtest str = raise (TestException str) + +type Basics() = + [] + member __.testShortCircuitResult() = + printfn "Running testShortCircuitResult..." + let t = + valuetask { + let! x = ValueTask.FromResult(1) + let! y = ValueTask.FromResult(2) + return x + y + } + require t.IsCompleted "didn't short-circuit already completed tasks" + printfn "t.Result = %A" t.Result + require (t.Result = 3) "wrong result" + + [] + member __.testDelay() = + printfn "Running testDelay..." + let mutable x = 0 + let t = + valuetask { + do! Task.Delay(50) + x <- x + 1 + } + printfn "task created and first step run...." + require (x = 0) "task already ran" + printfn "waiting...." + wait t + + [] + member __.testNoDelay() = + printfn "Running testNoDelay..." + let mutable x = 0 + let t = + valuetask { + x <- x + 1 + do! Task.Delay(5) + x <- x + 1 + } + require (x = 1) "first part didn't run yet" + wait t + + [] + member __.testNonBlocking() = + printfn "Running testNonBlocking..." + let sw = Stopwatch() + sw.Start() + let t = + valuetask { + do! Task.Yield() + Thread.Sleep(100) + } + sw.Stop() + require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller" + wait t + + [] + member __.testCatching1() = + printfn "Running testCatching1..." + let mutable x = 0 + let mutable y = 0 + let t = + valuetask { + try + do! Task.Delay(0) + failtest "hello" + x <- 1 + do! Task.Delay(100) + with + | TestException msg -> + require (msg = "hello") "message tampered" + | _ -> + require false "other exn type" + require false "other exn type" + y <- 1 + } + wait t + require (y = 1) "bailed after exn" + require (x = 0) "ran past failure" + + [] + member __.testCatching2() = + printfn "Running testCatching2..." + let mutable x = 0 + let mutable y = 0 + let t = + valuetask { + try + do! Task.Yield() // can't skip through this + failtest "hello" + x <- 1 + do! Task.Delay(100) + with + | TestException msg -> + require (msg = "hello") "message tampered" + | _ -> + require false "other exn type" + y <- 1 + } + wait t + require (y = 1) "bailed after exn" + require (x = 0) "ran past failure" + + [] + member __.testNestedCatching() = + printfn "Running testNestedCatching..." + let mutable counter = 1 + let mutable caughtInner = 0 + let mutable caughtOuter = 0 + let t1() = + valuetask { + try + do! Task.Yield() + failtest "hello" + with + | TestException msg as exn -> + caughtInner <- counter + counter <- counter + 1 + raise exn + } + let t2 = + valuetask { + try + do! t1() + with + | TestException msg as exn -> + caughtOuter <- counter + raise exn + | e -> + require false (sprintf "invalid msg type %s" e.Message) + } + try + wait t2 + 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" + + [] + member __.testWhileLoopSync() = + printfn "Running testWhileLoopSync..." + let t = + valuetask { + let mutable i = 0 + while i < 10 do + i <- i + 1 + return i + } + //t.Wait() no wait required for sync loop + require (t.IsCompleted) "didn't do sync while loop properly - not completed" + require (t.Result = 10) "didn't do sync while loop properly - wrong result" + + [] + member __.testWhileLoopAsyncZeroIteration() = + printfn "Running testWhileLoopAsyncZeroIteration..." + for i in 1 .. 5 do + let t = + valuetask { + let mutable i = 0 + while i < 0 do + i <- i + 1 + do! Task.Yield() + return i + } + wait t + require (t.Result = 0) "didn't do while loop properly" + + [] + member __.testWhileLoopAsyncOneIteration() = + printfn "Running testWhileLoopAsyncOneIteration..." + for i in 1 .. 5 do + let t = + valuetask { + let mutable i = 0 + while i < 1 do + i <- i + 1 + do! Task.Yield() + return i + } + wait t + require (t.Result = 1) "didn't do while loop properly" + + [] + member __.testWhileLoopAsync() = + printfn "Running testWhileLoopAsync..." + for i in 1 .. 5 do + let t = + valuetask { + let mutable i = 0 + while i < 10 do + i <- i + 1 + do! Task.Yield() + return i + } + wait t + require (t.Result = 10) "didn't do while loop properly" + + [] + member __.testTryFinallyHappyPath() = + printfn "Running testTryFinallyHappyPath..." + for i in 1 .. 5 do + let mutable ran = false + let t = + valuetask { + try + require (not ran) "ran way early" + do! Task.Delay(100) + require (not ran) "ran kinda early" + finally + ran <- true + } + wait t + require ran "never ran" + [] + member __.testTryFinallySadPath() = + printfn "Running testTryFinallySadPath..." + for i in 1 .. 5 do + let mutable ran = false + let t = + valuetask { + try + require (not ran) "ran way early" + do! Task.Delay(100) + require (not ran) "ran kinda early" + failtest "uhoh" + finally + ran <- true + } + try + wait t + with + | _ -> () + require ran "never ran" + + [] + member __.testTryFinallyCaught() = + printfn "Running testTryFinallyCaught..." + for i in 1 .. 5 do + let mutable ran = false + let t = + valuetask { + try + try + require (not ran) "ran way early" + do! Task.Delay(100) + require (not ran) "ran kinda early" + failtest "uhoh" + finally + ran <- true + return 1 + with + | _ -> return 2 + } + require (t.Result = 2) "wrong return" + require ran "never ran" + + [] + member __.testUsing() = + printfn "Running testUsing..." + for i in 1 .. 5 do + let mutable disposed = false + let t = + valuetask { + use d = { new IDisposable with member __.Dispose() = disposed <- true } + require (not disposed) "disposed way early" + do! Task.Delay(100) + require (not disposed) "disposed kinda early" + } + wait t + require disposed "never disposed B" + + [] + member __.testUsingAsyncDisposableSync() = + printfn "Running testUsingAsyncDisposableSync..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetask { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetask { + System.Console.WriteLine "incrementing" + disposed <- disposed + 1 } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + System.Console.WriteLine "delaying" + do! Task.Delay(100) + System.Console.WriteLine "testing" + require (disposed = 0) "disposed kinda early" + } + wait t + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableAsync() = + printfn "Running testUsingAsyncDisposableAsync..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetask { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetask { + do! Task.Delay(10) + disposed <- disposed + 1 + } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + do! Task.Delay(100) + require (disposed = 0) "disposed kinda early" + } + wait t + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableExnAsync() = + printfn "Running testUsingAsyncDisposableExnAsync..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetask { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetask { + do! Task.Delay(10) + disposed <- disposed + 1 + } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + failtest "oops" + + } + try wait t + with | :? AggregateException -> + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableExnSync() = + printfn "Running testUsingAsyncDisposableExnSync..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetask { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetask { + disposed <- disposed + 1 + do! Task.Delay(10) + } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + failtest "oops" + + } + try wait t + with | :? AggregateException -> + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableDelayExnSync() = + printfn "Running testUsingAsyncDisposableDelayExnSync..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetask { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetask { + disposed <- disposed + 1 + do! Task.Delay(10) + } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + do! Task.Delay(10) + require (disposed = 0) "disposed kind of early" + failtest "oops" + + } + try wait t + with | :? AggregateException -> + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + // Test use! resolves + member __.testUsingBindAsyncDisposableSync() = + printfn "Running testUsingBindAsyncDisposableSync..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetask { + use! d = + valuetask { + do! Task.Delay(10) + return + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetask { + System.Console.WriteLine "incrementing" + disposed <- disposed + 1 } + |> unitvaluetask + } + } + require (disposed = 0) "disposed way early" + System.Console.WriteLine "delaying" + do! Task.Delay(100) + System.Console.WriteLine "testing" + require (disposed = 0) "disposed kinda early" + } + wait t + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableSyncSupportingBothDisposables() = + printfn "Running testUsingAsyncDisposableSyncSupportingBothDisposables..." + for i in 1 .. 5 do + let disp = new SupportBothDisposables() + let t = + valuetask { + use d = disp + require (not disp.Disposed) "disposed way early" + System.Console.WriteLine "delaying" + do! Task.Delay(100) + System.Console.WriteLine "testing" + require (not disp.Disposed) "disposed kinda early" + } + wait t + require disp.Disposed "never disposed B" + + [] + member __.testUsingFromTask() = + printfn "Running testUsingFromTask..." + let mutable disposedInner = false + let mutable disposed = false + let t = + valuetask { + use! d = + valuetask { + do! Task.Delay(50) + 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! Task.Delay(50) + require (not disposed) "disposed kinda early" + } + wait t + require disposed "never disposed C" + + [] + member __.testUsingSadPath() = + printfn "Running testUsingSadPath..." + let mutable disposedInner = false + let mutable disposed = false + let t = + valuetask { + try + use! d = + valuetask { + do! Task.Delay(50) + 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 -> + printfn "caught TestException" + require disposedInner "did not dispose inner after task completion" + require (not disposed) "disposed way early" + do! Task.Delay(50) + printfn "resumed after delay" + require (not disposed) "disposed kinda early" + } + wait t + require (not disposed) "disposed thing that never should've existed" + + [] + member __.testForLoopA() = + printfn "Running testForLoopA..." + let list = ["a"; "b"; "c"] |> Seq.ofList + let t = + valuetask { + printfn "entering loop..." + let mutable x = Unchecked.defaultof<_> + let e = list.GetEnumerator() + while e.MoveNext() do + x <- e.Current + printfn "x = %A" x + do! Task.Yield() + printfn "x = %A" x + } + wait t + + [] + member __.testForLoopComplex() = + printfn "Running testForLoopComplex..." + 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 = + valuetask { + let mutable index = 0 + do! Task.Yield() + printfn "entering loop..." + for x in wrapList do + printfn "x = %A, index = %d" x index + do! Task.Yield() + printfn "back from yield" + do! Task.Yield() + printfn "back from 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 + printfn "yield again" + do! Task.Yield() + printfn "yield again again" + do! Task.Yield() + printfn "looping again..." + do! Task.Yield() + return 1 + } + wait t + require disposed "never disposed D" + require (t.Result = 1) "wrong result" + + [] + member __.testForLoopSadPath() = + printfn "Running testForLoopSadPath..." + for i in 1 .. 5 do + let wrapList = ["a"; "b"; "c"] + let t = + valuetask { + let mutable index = 0 + do! Task.Yield() + for x in wrapList do + do! Task.Yield() + index <- index + 1 + return 1 + } + require (t.Result = 1) "wrong result" + + [] + member __.testForLoopSadPathComplex() = + printfn "Running testForLoopSadPathComplex..." + for i in 1 .. 5 do + 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 = + valuetask { + try + let mutable index = 0 + do! Task.Yield() + for x in wrapList do + do! Task.Yield() + match index with + | 0 -> require (x = "a") "wrong first value" + | _ -> failtest "uhoh" + index <- index + 1 + do! Task.Yield() + do! Task.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 A" + + [] + member __.testExceptionAttachedToTaskWithoutAwait() = + for i in 1 .. 5 do + let mutable ranA = false + let mutable ranB = false + let t = + valuetask { + ranA <- true + failtest "uhoh" + ranB <- true + } + require ranA "didn't run immediately" + require (not ranB) "ran past exception" + require (not (isNull (t.AsTask().Exception))) "didn't capture exception" + require (t.AsTask().Exception.InnerExceptions.Count = 1) "captured more exceptions" + require (t.AsTask().Exception.InnerException = TestException "uhoh") "wrong exception" + let mutable caught = false + let mutable ranCatcher = false + let catcher = + valuetask { + 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" + + [] + member __.testExceptionAttachedToTaskWithAwait() = + printfn "running testExceptionAttachedToTaskWithAwait" + for i in 1 .. 5 do + let mutable ranA = false + let mutable ranB = false + let t = + valuetask { + ranA <- true + failtest "uhoh" + do! Task.Delay(100) + ranB <- true + } + require ranA "didn't run immediately" + require (not ranB) "ran past exception" + require (not (isNull (t.AsTask().Exception))) "didn't capture exception" + require (t.AsTask().Exception.InnerExceptions.Count = 1) "captured more exceptions" + require (t.AsTask().Exception.InnerException = TestException "uhoh") "wrong exception" + let mutable caught = false + let mutable ranCatcher = false + let catcher = + valuetask { + 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" + + [] + member __.testExceptionThrownInFinally() = + printfn "running testExceptionThrownInFinally" + for i in 1 .. 5 do + let mutable ranInitial = false + let mutable ranNext = false + let mutable ranFinally = 0 + let t = + valuetask { + try + ranInitial <- true + do! Task.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 + wait t + require false "shouldn't get here" + with + | _ -> () + require ranNext "didn't run next" + require (ranFinally = 1) "didn't run finally exactly once" + + [] + member __.test2ndExceptionThrownInFinally() = + printfn "running test2ndExceptionThrownInFinally" + for i in 1 .. 5 do + let mutable ranInitial = false + let mutable ranNext = false + let mutable ranFinally = 0 + let t = + valuetask { + try + ranInitial <- true + do! Task.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 + wait t + require false "shouldn't get here" + with + | _ -> () + require ranNext "didn't run next" + require (ranFinally = 1) "didn't run finally exactly once" + + [] + member __.testFixedStackWhileLoop() = + printfn "running testFixedStackWhileLoop" + for i in 1 .. 100 do + let t = + valuetask { + let mutable maxDepth = Nullable() + let mutable i = 0 + while i < BIG do + i <- i + 1 + do! Task.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 + } + wait t + require (t.Result = BIG) "didn't get to big number" + + [] + member __.testFixedStackForLoop() = + for i in 1 .. 100 do + printfn "running testFixedStackForLoop" + let mutable ran = false + let t = + valuetask { + let mutable maxDepth = Nullable() + for i in Seq.init BIG id do + do! Task.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 () + } + wait t + require ran "didn't run all" + + [] + member __.testTypeInference() = + let t1 : string ValueTask = + valuetask { + return "hello" + } + let t2 = + valuetask { + let! s = t1 + return s.Length + } + wait t2 + + [] + member __.testNoStackOverflowWithImmediateResult() = + printfn "running testNoStackOverflowWithImmediateResult" + let longLoop = + valuetask { + let mutable n = 0 + while n < BIG do + n <- n + 1 + return! ValueTask.FromResult(()) + } + wait longLoop + + [] + member __.testNoStackOverflowWithYieldResult() = + printfn "running testNoStackOverflowWithYieldResult" + let longLoop = + valuetask { + let mutable n = 0 + while n < BIG do + let! _ = + task { + do! Task.Yield() + let! _ = ValueTask.FromResult(0) + n <- n + 1 + } + n <- n + 1 + } + wait longLoop + + [] + member __.testSmallTailRecursion() = + printfn "running testSmallTailRecursion" + let rec loop n = + valuetask { + if n < 100 then + do! Task.Yield() + let! _ = ValueTask.FromResult(0) + return! loop (n + 1) + else + return () + } + let shortLoop = + valuetask { + return! loop 0 + } + wait shortLoop + + [] + member __.testTryOverReturnFrom() = + printfn "running testTryOverReturnFrom" + let inner() = + valuetask { + do! Task.Yield() + failtest "inner" + return 1 + } + let t = + valuetask { + try + do! Task.Yield() + return! inner() + with + | TestException "inner" -> return 2 + } + require (t.Result = 2) "didn't catch" + + [] + member __.testTryFinallyOverReturnFromWithException() = + printfn "running testTryFinallyOverReturnFromWithException" + let inner() = + valuetask { + do! Task.Yield() + failtest "inner" + return 1 + } + let mutable m = 0 + let t = + valuetask { + try + do! Task.Yield() + return! inner() + finally + m <- 1 + } + try + wait t + with + | :? AggregateException -> () + require (m = 1) "didn't run finally" + + [] + member __.testTryFinallyOverReturnFromWithoutException() = + printfn "running testTryFinallyOverReturnFromWithoutException" + let inner() = + valuetask { + do! Task.Yield() + return 1 + } + let mutable m = 0 + let t = + valuetask { + try + do! Task.Yield() + return! inner() + finally + m <- 1 + } + try + wait t + 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 + member __.testTrivialReturnCompiles (x : 'a) : 'a ValueTask = + valuetask { + do! Task.Yield() + return x + } + + // no need to call this, we just want to check that it compiles w/o warnings + member __.testTrivialTransformedReturnCompiles (x : 'a) (f : 'a -> 'b) : 'b ValueTask = + valuetask { + do! Task.Yield() + return f x + } + + [] + member __.testAsyncsMixedWithTasks() = + let t = + valuetask { + do! Task.Delay(1) + do! Async.Sleep(1) + let! x = + async { + do! Async.Sleep(1) + return 5 + } + return! async { return x + 3 } + } + 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 + member __.testDefaultInferenceForReturnFrom() = + let t = valuetask { return Some "x" } + valuetask { + let! r = t + if r = None then + return! failwithf "Could not find x" + else + return r + } + |> ignore + + [] + // no need to call this, just check that it compiles + member __.testCompilerInfersArgumentOfReturnFrom() = + valuetask { + if true then return 1 + else return! failwith "" + } + |> ignore + +[] +type BasicsNotInParallel() = + + [] + member __.testTaskUsesSyncContext() = + printfn "Running testBackgroundTask..." + for i in 1 .. 5 do + let mutable ran = false + let mutable posted = false + let oldSyncContext = SynchronizationContext.Current + let syncContext = { new SynchronizationContext() with member _.Post(d,state) = posted <- true; d.Invoke(state) } + try + SynchronizationContext.SetSynchronizationContext syncContext + let tid = System.Threading.Thread.CurrentThread.ManagedThreadId + require (not (isNull SynchronizationContext.Current)) "need sync context non null on foreground thread A" + require (SynchronizationContext.Current = syncContext) "need sync context known on foreground thread A" + let t = + valuetask { + let tid2 = System.Threading.Thread.CurrentThread.ManagedThreadId + require (not (isNull SynchronizationContext.Current)) "need sync context non null on foreground thread B" + require (SynchronizationContext.Current = syncContext) "need sync context known on foreground thread B" + require (tid = tid2) "expected synchronous start for task B2" + do! Task.Yield() + require (not (isNull SynchronizationContext.Current)) "need sync context non null on foreground thread C" + require (SynchronizationContext.Current = syncContext) "need sync context known on foreground thread C" + ran <- true + } + wait t + require ran "never ran" + require posted "never posted" + finally + SynchronizationContext.SetSynchronizationContext oldSyncContext + + +type Issue12184() = + member this.TaskMethod() = + valuetask { + // The overload resolution for Bind commits to 'Async' since the type annotation is present. + let! result = this.AsyncMethod(21) + return result + } + + member _.AsyncMethod(value: int) : Async = + async { + return (value * 2) + } + +type Issue12184b() = + member this.TaskMethod() = + valuetask { + // The overload resolution for Bind commits to 'YieldAwaitable' since the type annotation is present. + let! result = this.AsyncMethod(21) + return result + } + + member _.AsyncMethod(_value: int) : System.Runtime.CompilerServices.YieldAwaitable = + Task.Yield() + +// check this compiles +module Issue12184c = + let TaskMethod(t) = + valuetask { + // The overload resolution for Bind commits to 'Task<_>' via overload since no type annotation is available + // + // This should not do an early commit to "task like" nor propogate SRTP constraints from the task-like overload for Bind. + let! result = t + return result + } + +// check this compiles +module Issue12184d = + let TaskMethod(t: ValueTask) = + valuetask { + // The overload resolution for Bind commits to 'ValueTask' via SRTP pattern since the type annotation is available + let! result = t + return result + } + +// check this compiles +module Issue12184e = + let TaskMethod(t: ValueTask) = + valuetask { + // The overload resolution for Bind commits to 'ValueTask<_>' via SRTP pattern since the type annotation is available + let! result = t + return result + } + +// check this compiles +module Issue12184f = + let TaskMethod(t: Task) = + valuetask { + // The overload resolution for Bind commits to 'Task' via SRTP pattern since the type annotation is available + let! result = t + return result + } + +#if STANDALONE +module M = + [] + let main argv = + printfn "Running tests..." + try + Basics().testShortCircuitResult() + Basics().testDelay() + Basics().testNoDelay() + Basics().testNonBlocking() + + Basics().testCatching1() + Basics().testCatching2() + Basics().testNestedCatching() + Basics().testWhileLoopSync() + Basics().testWhileLoopAsyncZeroIteration() + Basics().testWhileLoopAsyncOneIteration() + Basics().testWhileLoopAsync() + Basics().testTryFinallyHappyPath() + Basics().testTryFinallySadPath() + Basics().testTryFinallyCaught() + Basics().testUsing() + Basics().testUsingFromTask() + Basics().testUsingSadPath() + Basics().testForLoopA() + Basics().testForLoopSadPath() + Basics().testForLoopSadPathComplex() + Basics().testExceptionAttachedToTaskWithoutAwait() + Basics().testExceptionAttachedToTaskWithAwait() + Basics().testExceptionThrownInFinally() + Basics().test2ndExceptionThrownInFinally() + Basics().testFixedStackWhileLoop() + Basics().testFixedStackForLoop() + Basics().testTypeInference() + Basics().testNoStackOverflowWithImmediateResult() + Basics().testNoStackOverflowWithYieldResult() + ////// 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() + Basics().testTryOverReturnFrom() + Basics().testTryFinallyOverReturnFromWithException() + Basics().testTryFinallyOverReturnFromWithoutException() + Basics().testAsyncsMixedWithTasks() + printfn "Passed all tests!" + with exn -> + eprintfn "************************************" + eprintfn "Exception: %O" exn + printfn "Test failed... exiting..." + eprintfn "************************************" + exit 1 + + printfn "Tests passed ok..., sleeping a bit in case there are background delayed exceptions" + Thread.Sleep(500) + printfn "Exiting..." + //System.Console.ReadLine() + 0 +#endif +#endif diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/ValueTasksDynamic.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/ValueTasksDynamic.fs new file mode 100644 index 00000000000..08c435e0435 --- /dev/null +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/ValueTasksDynamic.fs @@ -0,0 +1,1310 @@ +// Tests for TaskBuilder.fs +// +// Written in 2016 by Robert Peele (humbobst@gmail.com) +// +// To the extent possible under law, the author(s) have dedicated all copyright and related and neighboring rights +// to this software to the public domain worldwide. This software is distributed without any warranty. +// +// You should have received a copy of the CC0 Public Domain Dedication along with this software. +// If not, see . +// +// +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +// Various tests for the 'dynamic' implementation of the task type when state machine +// compilation fails. + +namespace FSharp.Core.UnitTests.Control.ValueTasksDynamic +#if NETCOREAPP +#nowarn "1204" // construct only for use in compiled code +#nowarn "3511" // state machine not staticlly compilable - the one in 'Run' +open System +open System.Collections +open System.Collections.Generic +open System.Diagnostics +open System.Threading +open System.Threading.Tasks +open Microsoft.FSharp.Control +#if STANDALONE +[] +type FactAttribute() = inherit Attribute() +#else +open Xunit +open System.Runtime.CompilerServices + +#endif + +// Delegates to task, except 'Run' which is deliberately not inlined, hence no chance +// of static compilation of state machines. +type ValueTaskBuilderDynamic() = + + [] + member _.Run(code) = valuetask.Run(code) // warning 3511 is generated here: state machine not compilable + + member inline _.Delay f = valuetask.Delay(f) + [] + member inline _.Zero() = valuetask.Zero() + member inline _.Return (value) = valuetask.Return(value) + member inline _.Combine(task1, task2) = valuetask.Combine(task1, task2) + member inline _.While ([] condition, body) = valuetask.While(condition, body) + member inline _.TryWith (body, catch) = valuetask.TryWith(body, catch) + member inline _.TryFinally (body, compensation ) = valuetask.TryFinally(body, compensation) + member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IAsyncDisposable> (resource: 'Resource, body: 'Resource -> ValueTaskCode<'TOverall, 'T>) = + valuetask.Using(resource, body) + member inline _.For (sequence, body) = valuetask.For(sequence, body) + member inline _.ReturnFrom (t: ValueTask<'T>) = valuetask.ReturnFrom(t) + +[] +module TaskBuilderDynamicLowPriority = + + // Low priority extension method + type ValueTaskBuilderDynamic with + member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposable> (resource: 'Resource, body: 'Resource -> ValueTaskCode<'TOverall, 'T>) = + valuetask.Using(resource, body) + + +[] +module Value = + + [] + module ValueTaskLowProrityExtensions = + + type ValueTaskBuilderDynamic with + member inline _.ReturnFrom< ^TaskLike, ^Awaiter, ^T + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> ^T)> + (t: ^TaskLike) : ValueTaskCode< ^T, ^T> = + valuetask.ReturnFrom(t) + member inline _.Bind< ^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> ^TResult1)> + (t: ^TaskLike, continuation: (^TResult1 -> ValueTaskCode<'TOverall, 'TResult2>)) : ValueTaskCode<'TOverall, 'TResult2> = + valuetask.Bind(t, continuation) + + + [] + module HighLowProrityExtensions = + + type ValueTaskBuilderDynamic with + member inline _.Bind (t: ValueTask<'TResult1>, continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>)) : ValueTaskCode<'TOverall, 'TResult2> = + valuetask.Bind(t, continuation) + + member inline _.Bind (computation: Async<'TResult1>, continuation: ('TResult1 -> ValueTaskCode<'TOverall, 'TResult2>)) : ValueTaskCode<'TOverall, 'TResult2> = + valuetask.Bind(computation, continuation) + + member inline _.ReturnFrom (t: ValueTask<'T>) : ValueTaskCode<'T, 'T> = + valuetask.ReturnFrom(t) + + member inline _.ReturnFrom (computation: Async<'T>) : ValueTaskCode<'T, 'T> = + valuetask.ReturnFrom(computation) + + + + let valuetaskDynamic = ValueTaskBuilderDynamic() + type Do_no_use_valuetask_in_this_file_use_taskDynamic_instead = | Nope + let valuetask = Do_no_use_valuetask_in_this_file_use_taskDynamic_instead.Nope + +[] +module ValueTask = + let wait (task :ValueTask<'t>) = + if not task.IsCompleted then + task.AsTask().Wait() + + let unitvaluetask (task: ValueTask) : ValueTask = + if task.IsCompleted then + ValueTask.CompletedTask + else + task.AsTask() |> ValueTask + + +type ITaskThing = + abstract member Taskify : 'a option -> 'a ValueTask + +type SmokeTestsForCompilation() = + + [] + member __.tinyTask() = + valuetaskDynamic { + return 1 + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + [] + member __.tbind() = + valuetaskDynamic { + let! x = ValueTask.FromResult(1) + return 1 + x + } + |> fun t -> + wait t + if t.Result <> 2 then failwith "failed" + + [] + member __.tnested() = + valuetaskDynamic { + let! x = valuetaskDynamic { return 1 } + return x + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + [] + member __.tcatch0() = + valuetaskDynamic { + try + return 1 + with e -> + return 2 + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + [] + member __.tcatch1() = + valuetaskDynamic { + try + let! x = ValueTask.FromResult 1 + return x + with e -> + return 2 + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + + [] + member __.t3() = + let t2() = + valuetaskDynamic { + System.Console.WriteLine("hello") + return 1 + } + valuetaskDynamic { + System.Console.WriteLine("hello") + let! x = t2() + System.Console.WriteLine("world") + return 1 + x + } + |> fun t -> + wait t + if t.Result <> 2 then failwith "failed" + + [] + member __.t3b() = + valuetaskDynamic { + System.Console.WriteLine("hello") + let! x = ValueTask.FromResult(1) + System.Console.WriteLine("world") + return 1 + x + } + |> fun t -> + wait t + if t.Result <> 2 then failwith "failed" + + [] + member __.t3c() = + valuetaskDynamic { + System.Console.WriteLine("hello") + do! Task.Delay(100) + System.Console.WriteLine("world") + return 1 + } + |> fun t -> + wait t + if t.Result <> 1 then failwith "failed" + + [] + // This tests an exception match + member __.t67() = + valuetaskDynamic { + try + do! Task.Delay(0) + with + | :? ArgumentException -> + () + | _ -> + () + } + |> fun t -> + wait t + if t.Result <> () then failwith "failed" + + [] + // This tests compiling an incomplete exception match + member __.t68() = + valuetaskDynamic { + try + do! Task.Delay(0) + with + | :? ArgumentException -> + () + } + |> fun t -> + wait t + if t.Result <> () then failwith "failed" + + [] + member __.testCompileAsyncWhileLoop() = + valuetaskDynamic { + let mutable i = 0 + while i < 5 do + i <- i + 1 + do! Task.Yield() + return i + } + |> fun t -> + wait t + if t.Result <> 5 then failwith "failed" + + +exception TestException of string + +[] +module Helpers = + let BIG = 10 + // let BIG = 10000 + let require x msg = if not x then failwith msg + let failtest str = raise (TestException str) + +type Basics() = + [] + member __.testShortCircuitResult() = + printfn "Running testShortCircuitResult..." + let t = + valuetaskDynamic { + let! x = ValueTask.FromResult(1) + let! y = ValueTask.FromResult(2) + return x + y + } + require t.IsCompleted "didn't short-circuit already completed tasks" + printfn "t.Result = %A" t.Result + require (t.Result = 3) "wrong result" + + [] + member __.testDelay() = + printfn "Running testDelay..." + let mutable x = 0 + let t = + valuetaskDynamic { + do! Task.Delay(50) + x <- x + 1 + } + printfn "task created and first step run...." + require (x = 0) "task already ran" + printfn "waiting...." + wait t + + [] + member __.testNoDelay() = + printfn "Running testNoDelay..." + let mutable x = 0 + let t = + valuetaskDynamic { + x <- x + 1 + do! Task.Delay(5) + x <- x + 1 + } + require (x = 1) "first part didn't run yet" + wait t + + [] + member __.testNonBlocking() = + printfn "Running testNonBlocking..." + let sw = Stopwatch() + sw.Start() + let t = + valuetaskDynamic { + do! Task.Yield() + Thread.Sleep(100) + } + sw.Stop() + require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller" + wait t + + [] + member __.testCatching1() = + printfn "Running testCatching1..." + let mutable x = 0 + let mutable y = 0 + let t = + valuetaskDynamic { + try + do! Task.Delay(0) + failtest "hello" + x <- 1 + do! Task.Delay(100) + with + | TestException msg -> + require (msg = "hello") "message tampered" + | _ -> + require false "other exn type" + require false "other exn type" + y <- 1 + } + wait t + require (y = 1) "bailed after exn" + require (x = 0) "ran past failure" + + [] + member __.testCatching2() = + printfn "Running testCatching2..." + let mutable x = 0 + let mutable y = 0 + let t = + valuetaskDynamic { + try + do! Task.Yield() // can't skip through this + failtest "hello" + x <- 1 + do! Task.Delay(100) + with + | TestException msg -> + require (msg = "hello") "message tampered" + | _ -> + require false "other exn type" + y <- 1 + } + wait t + require (y = 1) "bailed after exn" + require (x = 0) "ran past failure" + + [] + member __.testNestedCatching() = + printfn "Running testNestedCatching..." + let mutable counter = 1 + let mutable caughtInner = 0 + let mutable caughtOuter = 0 + let t1() = + valuetaskDynamic { + try + do! Task.Yield() + failtest "hello" + with + | TestException msg as exn -> + caughtInner <- counter + counter <- counter + 1 + raise exn + } + let t2 = + valuetaskDynamic { + try + do! t1() + with + | TestException msg as exn -> + caughtOuter <- counter + raise exn + | e -> + require false (sprintf "invalid msg type %s" e.Message) + } + try + wait t2 + 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" + + [] + member __.testWhileLoopSync() = + printfn "Running testWhileLoopSync..." + let t = + valuetaskDynamic { + let mutable i = 0 + while i < 10 do + i <- i + 1 + return i + } + //wait t no wait required for sync loop + require (t.IsCompleted) "didn't do sync while loop properly - not completed" + require (t.Result = 10) "didn't do sync while loop properly - wrong result" + + [] + member __.testWhileLoopAsyncZeroIteration() = + printfn "Running testWhileLoopAsyncZeroIteration..." + for i in 1 .. 5 do + let t = + valuetaskDynamic { + let mutable i = 0 + while i < 0 do + i <- i + 1 + do! Task.Yield() + return i + } + wait t + require (t.Result = 0) "didn't do while loop properly" + + [] + member __.testWhileLoopAsyncOneIteration() = + printfn "Running testWhileLoopAsyncOneIteration..." + for i in 1 .. 5 do + let t = + valuetaskDynamic { + let mutable i = 0 + while i < 1 do + i <- i + 1 + do! Task.Yield() + return i + } + wait t + require (t.Result = 1) "didn't do while loop properly" + + [] + member __.testWhileLoopAsync() = + printfn "Running testWhileLoopAsync..." + for i in 1 .. 5 do + let t = + valuetaskDynamic { + let mutable i = 0 + while i < 10 do + i <- i + 1 + do! Task.Yield() + return i + } + wait t + require (t.Result = 10) "didn't do while loop properly" + + [] + member __.testTryFinallyHappyPath() = + printfn "Running testTryFinallyHappyPath..." + for i in 1 .. 5 do + let mutable ran = false + let t = + valuetaskDynamic { + try + require (not ran) "ran way early" + do! Task.Delay(100) + require (not ran) "ran kinda early" + finally + ran <- true + } + wait t + require ran "never ran" + [] + member __.testTryFinallySadPath() = + printfn "Running testTryFinallySadPath..." + for i in 1 .. 5 do + let mutable ran = false + let t = + valuetaskDynamic { + try + require (not ran) "ran way early" + do! Task.Delay(100) + require (not ran) "ran kinda early" + failtest "uhoh" + finally + ran <- true + } + try + wait t + with + | _ -> () + require ran "never ran" + + [] + member __.testTryFinallyCaught() = + printfn "Running testTryFinallyCaught..." + for i in 1 .. 5 do + let mutable ran = false + let t = + valuetaskDynamic { + try + try + require (not ran) "ran way early" + do! Task.Delay(100) + require (not ran) "ran kinda early" + failtest "uhoh" + finally + ran <- true + return 1 + with + | _ -> return 2 + } + require (t.Result = 2) "wrong return" + require ran "never ran" + + [] + member __.testUsing() = + printfn "Running testUsing..." + for i in 1 .. 5 do + let mutable disposed = false + let t = + valuetaskDynamic { + use d = { new IDisposable with member __.Dispose() = disposed <- true } + require (not disposed) "disposed way early" + do! Task.Delay(100) + require (not disposed) "disposed kinda early" + } + wait t + require disposed "never disposed B" + + [] + member __.testUsingAsyncDisposableSync() = + printfn "Running testUsing..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetaskDynamic { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetaskDynamic { + System.Console.WriteLine "incrementing" + disposed <- disposed + 1 } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + System.Console.WriteLine "delaying" + do! Task.Delay(100) + System.Console.WriteLine "testing" + require (disposed = 0) "disposed kinda early" + } + wait t + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableAsync() = + printfn "Running testUsing..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetaskDynamic { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetaskDynamic { + do! Task.Delay(10) + disposed <- disposed + 1 + } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + do! Task.Delay(100) + require (disposed = 0) "disposed kinda early" + } + wait t + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableExnAsync() = + printfn "Running testUsing..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetaskDynamic { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetaskDynamic { + do! Task.Delay(10) + disposed <- disposed + 1 + } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + failtest "oops" + + } + try wait t + with | :? AggregateException -> + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableExnSync() = + printfn "Running testUsing..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetaskDynamic { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetaskDynamic { + disposed <- disposed + 1 + do! Task.Delay(10) + } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + failtest "oops" + + } + try wait t + with | :? AggregateException -> + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingAsyncDisposableDelayExnSync() = + printfn "Running testUsing..." + for i in 1 .. 5 do + let mutable disposed = 0 + let t = + valuetaskDynamic { + use d = + { new IAsyncDisposable with + member __.DisposeAsync() = + valuetaskDynamic { + disposed <- disposed + 1 + do! Task.Delay(10) + } + |> unitvaluetask + } + require (disposed = 0) "disposed way early" + do! Task.Delay(10) + require (disposed = 0) "disposed kind of early" + failtest "oops" + + } + try wait t + with | :? AggregateException -> + require (disposed >= 1) "never disposed B" + require (disposed <= 1) "too many dispose on B" + + [] + member __.testUsingFromTask() = + printfn "Running testUsingFromTask..." + let mutable disposedInner = false + let mutable disposed = false + let t = + valuetaskDynamic { + use! d = + valuetaskDynamic { + do! Task.Delay(50) + 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! Task.Delay(50) + require (not disposed) "disposed kinda early" + } + wait t + require disposed "never disposed C" + + [] + member __.testUsingSadPath() = + printfn "Running testUsingSadPath..." + let mutable disposedInner = false + let mutable disposed = false + let t = + valuetaskDynamic { + try + use! d = + valuetaskDynamic { + do! Task.Delay(50) + 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 -> + printfn "caught TestException" + require disposedInner "did not dispose inner after task completion" + require (not disposed) "disposed way early" + do! Task.Delay(50) + printfn "resumed after delay" + require (not disposed) "disposed kinda early" + } + wait t + require (not disposed) "disposed thing that never should've existed" + + [] + member __.testForLoopA() = + printfn "Running testForLoopA..." + let list = ["a"; "b"; "c"] |> Seq.ofList + let t = + valuetaskDynamic { + printfn "entering loop..." + let mutable x = Unchecked.defaultof<_> + let e = list.GetEnumerator() + while e.MoveNext() do + x <- e.Current + printfn "x = %A" x + do! Task.Yield() + printfn "x = %A" x + } + wait t + + [] + member __.testForLoopComplex() = + printfn "Running testForLoopComplex..." + 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 = + valuetaskDynamic { + let mutable index = 0 + do! Task.Yield() + printfn "entering loop..." + for x in wrapList do + printfn "x = %A, index = %d" x index + do! Task.Yield() + printfn "back from yield" + do! Task.Yield() + printfn "back from 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 + printfn "yield again" + do! Task.Yield() + printfn "yield again again" + do! Task.Yield() + printfn "looping again..." + do! Task.Yield() + return 1 + } + wait t + require disposed "never disposed D" + require (t.Result = 1) "wrong result" + + [] + member __.testForLoopSadPath() = + printfn "Running testForLoopSadPath..." + for i in 1 .. 5 do + let wrapList = ["a"; "b"; "c"] + let t = + valuetaskDynamic { + let mutable index = 0 + do! Task.Yield() + for x in wrapList do + do! Task.Yield() + index <- index + 1 + return 1 + } + require (t.Result = 1) "wrong result" + + [] + member __.testForLoopSadPathComplex() = + printfn "Running testForLoopSadPathComplex..." + for i in 1 .. 5 do + 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 = + valuetaskDynamic { + try + let mutable index = 0 + do! Task.Yield() + for x in wrapList do + do! Task.Yield() + match index with + | 0 -> require (x = "a") "wrong first value" + | _ -> failtest "uhoh" + index <- index + 1 + do! Task.Yield() + do! Task.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 A" + + [] + member __.testExceptionAttachedToTaskWithoutAwait() = + for i in 1 .. 5 do + let mutable ranA = false + let mutable ranB = false + let t = + valuetaskDynamic { + ranA <- true + failtest "uhoh" + ranB <- true + } + require ranA "didn't run immediately" + require (not ranB) "ran past exception" + require (not (isNull (t.AsTask().Exception))) "didn't capture exception" + require (t.AsTask().Exception.InnerExceptions.Count = 1) "captured more exceptions" + require (t.AsTask().Exception.InnerException = TestException "uhoh") "wrong exception" + let mutable caught = false + let mutable ranCatcher = false + let catcher = + valuetaskDynamic { + 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" + + [] + member __.testExceptionAttachedToTaskWithAwait() = + printfn "running testExceptionAttachedToTaskWithAwait" + for i in 1 .. 5 do + let mutable ranA = false + let mutable ranB = false + let t = + valuetaskDynamic { + ranA <- true + failtest "uhoh" + do! Task.Delay(100) + ranB <- true + } + require ranA "didn't run immediately" + require (not ranB) "ran past exception" + require (not (isNull (t.AsTask().Exception))) "didn't capture exception" + require (t.AsTask().Exception.InnerExceptions.Count = 1) "captured more exceptions" + require (t.AsTask().Exception.InnerException = TestException "uhoh") "wrong exception" + let mutable caught = false + let mutable ranCatcher = false + let catcher = + valuetaskDynamic { + 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" + + [] + member __.testExceptionThrownInFinally() = + printfn "running testExceptionThrownInFinally" + for i in 1 .. 5 do + let mutable ranInitial = false + let mutable ranNext = false + let mutable ranFinally = 0 + let t = + valuetaskDynamic { + try + ranInitial <- true + do! Task.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 + wait t + require false "shouldn't get here" + with + | _ -> () + require ranNext "didn't run next" + require (ranFinally = 1) "didn't run finally exactly once" + + [] + member __.test2ndExceptionThrownInFinally() = + printfn "running test2ndExceptionThrownInFinally" + for i in 1 .. 5 do + let mutable ranInitial = false + let mutable ranNext = false + let mutable ranFinally = 0 + let t = + valuetaskDynamic { + try + ranInitial <- true + do! Task.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 + wait t + require false "shouldn't get here" + with + | _ -> () + require ranNext "didn't run next" + require (ranFinally = 1) "didn't run finally exactly once" + + [] + member __.testFixedStackWhileLoop() = + printfn "running testFixedStackWhileLoop" + for i in 1 .. 100 do + let t = + valuetaskDynamic { + let mutable maxDepth = Nullable() + let mutable i = 0 + while i < BIG do + i <- i + 1 + do! Task.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 + } + wait t + require (t.Result = BIG) "didn't get to big number" + + [] + member __.testFixedStackForLoop() = + for i in 1 .. 100 do + printfn "running testFixedStackForLoop" + let mutable ran = false + let t = + valuetaskDynamic { + let mutable maxDepth = Nullable() + for i in Seq.init BIG id do + do! Task.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 () + } + wait t + require ran "didn't run all" + + [] + member __.testTypeInference() = + let t1 : string ValueTask = + valuetaskDynamic { + return "hello" + } + let t2 = + valuetaskDynamic { + let! s = t1 + return s.Length + } + wait t2 + + [] + member __.testNoStackOverflowWithImmediateResult() = + printfn "running testNoStackOverflowWithImmediateResult" + let longLoop = + valuetaskDynamic { + let mutable n = 0 + while n < BIG do + n <- n + 1 + return! ValueTask.FromResult(()) + } + wait longLoop + + [] + member __.testNoStackOverflowWithYieldResult() = + printfn "running testNoStackOverflowWithYieldResult" + let longLoop = + valuetaskDynamic { + let mutable n = 0 + while n < BIG do + let! _ = + valuetaskDynamic { + do! Task.Yield() + let! _ = ValueTask.FromResult(0) + n <- n + 1 + } + n <- n + 1 + } + wait longLoop + + [] + member __.testSmallTailRecursion() = + printfn "running testSmallTailRecursion" + let rec loop n = + valuetaskDynamic { + if n < 100 then + do! Task.Yield() + let! _ = ValueTask.FromResult(0) + return! loop (n + 1) + else + return () + } + let shortLoop = + valuetaskDynamic { + return! loop 0 + } + wait shortLoop + + [] + member __.testTryOverReturnFrom() = + printfn "running testTryOverReturnFrom" + let inner() = + valuetaskDynamic { + do! Task.Yield() + failtest "inner" + return 1 + } + let t = + valuetaskDynamic { + try + do! Task.Yield() + return! inner() + with + | TestException "inner" -> return 2 + } + require (t.Result = 2) "didn't catch" + + [] + member __.testTryFinallyOverReturnFromWithException() = + printfn "running testTryFinallyOverReturnFromWithException" + let inner() = + valuetaskDynamic { + do! Task.Yield() + failtest "inner" + return 1 + } + let mutable m = 0 + let t = + valuetaskDynamic { + try + do! Task.Yield() + return! inner() + finally + m <- 1 + } + try + wait t + with + | :? AggregateException -> () + require (m = 1) "didn't run finally" + + [] + member __.testTryFinallyOverReturnFromWithoutException() = + printfn "running testTryFinallyOverReturnFromWithoutException" + let inner() = + valuetaskDynamic { + do! Task.Yield() + return 1 + } + let mutable m = 0 + let t = + valuetaskDynamic { + try + do! Task.Yield() + return! inner() + finally + m <- 1 + } + try + wait t + 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 + member __.testTrivialReturnCompiles (x : 'a) : 'a ValueTask = + valuetaskDynamic { + do! Task.Yield() + return x + } + + // no need to call this, we just want to check that it compiles w/o warnings + member __.testTrivialTransformedReturnCompiles (x : 'a) (f : 'a -> 'b) : 'b ValueTask = + valuetaskDynamic { + do! Task.Yield() + return f x + } + + [] + member __.testAsyncsMixedWithTasks() = + let t = + valuetaskDynamic { + do! Task.Delay(1) + do! Async.Sleep(1) + let! x = + async { + do! Async.Sleep(1) + return 5 + } + return! async { return x + 3 } + } + 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 + member __.testDefaultInferenceForReturnFrom() = + let t = valuetaskDynamic { return Some "x" } + valuetaskDynamic { + let! r = t + if r = None then + return! failwithf "Could not find x" + else + return r + } + |> ignore + + [] + // no need to call this, just check that it compiles + member __.testCompilerInfersArgumentOfReturnFrom() = + valuetaskDynamic { + if true then return 1 + else return! failwith "" + } + |> ignore + + +[] +type BasicsNotInParallel() = + + [] + member __.testTaskUsesSyncContext() = + printfn "Running testBackgroundTask..." + for i in 1 .. 5 do + let mutable ran = false + let mutable posted = false + let oldSyncContext = SynchronizationContext.Current + let syncContext = { new SynchronizationContext() with member _.Post(d,state) = posted <- true; d.Invoke(state) } + try + SynchronizationContext.SetSynchronizationContext syncContext + let tid = System.Threading.Thread.CurrentThread.ManagedThreadId + require (not (isNull SynchronizationContext.Current)) "need sync context non null on foreground thread A" + require (SynchronizationContext.Current = syncContext) "need sync context known on foreground thread A" + let t = + valuetaskDynamic { + let tid2 = System.Threading.Thread.CurrentThread.ManagedThreadId + require (not (isNull SynchronizationContext.Current)) "need sync context non null on foreground thread B" + require (SynchronizationContext.Current = syncContext) "need sync context known on foreground thread B" + require (tid = tid2) "expected synchronous start for task B2" + do! Task.Yield() + require (not (isNull SynchronizationContext.Current)) "need sync context non null on foreground thread C" + require (SynchronizationContext.Current = syncContext) "need sync context known on foreground thread C" + ran <- true + } + wait t + require ran "never ran" + require posted "never posted" + finally + SynchronizationContext.SetSynchronizationContext oldSyncContext + +#if STANDALONE +module M = + [] + let main argv = + printfn "Running tests..." + try + Basics().testShortCircuitResult() + Basics().testDelay() + Basics().testNoDelay() + Basics().testNonBlocking() + + Basics().testCatching1() + Basics().testCatching2() + Basics().testNestedCatching() + Basics().testWhileLoopSync() + Basics().testWhileLoopAsyncZeroIteration() + Basics().testWhileLoopAsyncOneIteration() + Basics().testWhileLoopAsync() + Basics().testTryFinallyHappyPath() + Basics().testTryFinallySadPath() + Basics().testTryFinallyCaught() + Basics().testUsing() + Basics().testUsingFromTask() + Basics().testUsingSadPath() + Basics().testForLoopA() + Basics().testForLoopSadPath() + Basics().testForLoopSadPathComplex() + Basics().testExceptionAttachedToTaskWithoutAwait() + Basics().testExceptionAttachedToTaskWithAwait() + Basics().testExceptionThrownInFinally() + Basics().test2ndExceptionThrownInFinally() + Basics().testFixedStackWhileLoop() + Basics().testFixedStackForLoop() + Basics().testTypeInference() + Basics().testNoStackOverflowWithImmediateResult() + Basics().testNoStackOverflowWithYieldResult() + ////// 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() + Basics().testTryOverReturnFrom() + Basics().testTryFinallyOverReturnFromWithException() + Basics().testTryFinallyOverReturnFromWithoutException() + Basics().testAsyncsMixedWithTasks() + printfn "Passed all tests!" + with exn -> + eprintfn "************************************" + eprintfn "Exception: %O" exn + printfn "Test failed... exiting..." + eprintfn "************************************" + exit 1 + + printfn "Tests passed ok..., sleeping a bit in case there are background delayed exceptions" + Thread.Sleep(500) + printfn "Exiting..." + //System.Console.ReadLine() + 0 +#endif +#endif