From 5d19ae33cacdabe09a117ff1d03c5a2385ca040d Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Thu, 15 Oct 2026 20:59:08 +0200 Subject: [PATCH 1/4] feat: support Async.TryCancelled on JS, Python and BEAM --- src/fable-library-beam/fable_async.erl | 17 ++ src/fable-library-py/fable_library/async_.py | 18 +++ src/fable-library-ts/Async.ts | 18 +++ tests/Beam/AsyncTests.fs | 28 ++++ tests/Beam/Fable.Tests.Beam.fsproj | 1 + tests/Js/Main/AsyncTests.fs | 8 + tests/Js/Main/Fable.Tests.fsproj | 1 + tests/Python/AsyncTryCancelled.fs | 148 ++++++++++++++++++ tests/Python/Fable.Tests.Python.fsproj | 1 + tests/Python/TestAsync.fs | 28 ++++ .../TypeScript/Fable.Tests.TypeScript.fsproj | 1 + 11 files changed, 269 insertions(+) create mode 100644 tests/Python/AsyncTryCancelled.fs diff --git a/src/fable-library-beam/fable_async.erl b/src/fable-library-beam/fable_async.erl index 96ca37d44b..848b9f6594 100644 --- a/src/fable-library-beam/fable_async.erl +++ b/src/fable-library-beam/fable_async.erl @@ -9,6 +9,7 @@ parallel/1, sequential/1, catch_async/1, + try_cancelled/2, ignore/1, from_continuations/1, start_as_task/1, @@ -43,6 +44,7 @@ -spec parallel(list() | reference()) -> async(reference()). -spec sequential(list()) -> async(list()). -spec catch_async(async(term())) -> async(term()). +-spec try_cancelled(async(term()), fun((term()) -> term())) -> async(term()). -spec ignore(async(term())) -> async(ok). -spec from_continuations(fun()) -> async(term()). -spec start_as_task(async(term())) -> term(). @@ -479,6 +481,21 @@ catch_async(Computation) -> end end. +%% TryCancelled: observe cancellation without changing its terminal outcome. +try_cancelled(Computation, Compensation) -> + fun(Ctx) -> + OnCancel = maps:get(on_cancel, Ctx), + Ctx2 = Ctx#{ + on_cancel => fun(Error) -> + %% decision: preserve the original cancellation even when compensation throws, matching .NET. + try Compensation(Error) catch _:_ -> ok end, + OnCancel(Error) + end + }, + %% invariant: install the handler without adding a cancellation checkpoint, including for nested handlers. + Computation(Ctx2) + end. + %% Ignore: discard result ignore(Computation) -> fable_async_builder:bind(Computation, fun(_) -> fable_async_builder:return(ok) end). diff --git a/src/fable-library-py/fable_library/async_.py b/src/fable-library-py/fable_library/async_.py index 4f82c01e59..61342be52f 100644 --- a/src/fable-library-py/fable_library/async_.py +++ b/src/fable-library-py/fable_library/async_.py @@ -215,6 +215,23 @@ def _arrow21(__unit: Unit = UNIT) -> Async[Array[T]]: return delay(delayed) +def try_cancelled[T](computation: Async[T], compensation: Callable[[OperationCanceledError], None]) -> Async[T]: + def cont(ctx: IAsyncContext[T]) -> None: + def on_cancel(error: OperationCanceledError) -> None: + # decision: preserves the original cancellation when compensation throws, matching .NET + try: + compensation(error) + except Exception: + pass + ctx.trampoline.run(lambda: ctx.on_cancel(error)) + + ctx_ = IAsyncContext.create(ctx.trampoline, ctx.cancel_token, ctx.on_success, ctx.on_error, on_cancel) + # invariant: installs the handler without adding a cancellation checkpoint, including for nested handlers + computation(ctx_) + + return cont + + def catch_async[T](work: Async[T]) -> Async[FSharpChoice_2[T, Exception]]: def cont(ctx: IAsyncContext[FSharpChoice_2[T, Exception]]) -> None: def on_success(x: T): @@ -523,4 +540,5 @@ def exception_handler(loop: asyncio.AbstractEventLoop, context: dict[str, Any]) "start_child", "start_immediate", "start_with_continuations", + "try_cancelled", ] diff --git a/src/fable-library-ts/Async.ts b/src/fable-library-ts/Async.ts index 09eaabee44..75ea833b19 100644 --- a/src/fable-library-ts/Async.ts +++ b/src/fable-library-ts/Async.ts @@ -127,6 +127,24 @@ export function catchAsync(work: Async) { }); } +export function tryCancelled(computation: Async, compensation: (error: OperationCanceledException) => void): Async { + return (ctx) => { + // invariant: install the handler without adding a cancellation checkpoint, including for nested handlers + computation({ + ...ctx, + onCancel: (error) => { + // decision: preserve the original cancellation even when compensation throws, matching .NET + try { compensation(error); } catch { /* Cancellation takes precedence. */ } + if (ctx.trampoline.incrementAndCheck()) { + ctx.trampoline.hijack(() => ctx.onCancel(error)); + } else { + ctx.onCancel(error); + } + }, + }); + }; +} + export function fromContinuations(f: (conts: Continuations) => void) { return (ctx: IAsyncContext) => { let settled = false; diff --git a/tests/Beam/AsyncTests.fs b/tests/Beam/AsyncTests.fs index b318fb914e..0985cf9002 100644 --- a/tests/Beam/AsyncTests.fs +++ b/tests/Beam/AsyncTests.fs @@ -7,6 +7,34 @@ open System.Threading let private raiseCaughtCancellation (error: exn) : unit = raise error +[] +let ``test TryCancelled preserves success and ordinary errors`` () = + AsyncTryCancelled.successAndFailure () + +[] +let ``test TryCancelled preserves cancellation identity and supports reuse`` () = + AsyncTryCancelled.cancellationIdentityAndReuse () + +[] +let ``test TryCancelled installs nested handlers before cancellation`` () = + AsyncTryCancelled.preCancelledNesting () + +[] +let ``test TryCancelled handles deferred cancellation`` () = + AsyncTryCancelled.deferredCancellation () + +[] +let ``test TryCancelled preserves finalizer order when handlers throw`` () = + AsyncTryCancelled.finalizerOrdering () + +[] +let ``test TryCancelled propagates downstream errors once`` () = + AsyncTryCancelled.downstreamExceptions () + +[] +let ``test TryCancelled preserves bounded trampoline execution`` () = + AsyncTryCancelled.trampoline () |> Async.RunSynchronously + [] let ``test RunSynchronously optional timeout and cancellation token`` () = let work = async { return 42 } diff --git a/tests/Beam/Fable.Tests.Beam.fsproj b/tests/Beam/Fable.Tests.Beam.fsproj index f310f1716d..3342326a39 100644 --- a/tests/Beam/Fable.Tests.Beam.fsproj +++ b/tests/Beam/Fable.Tests.Beam.fsproj @@ -74,6 +74,7 @@ + diff --git a/tests/Js/Main/AsyncTests.fs b/tests/Js/Main/AsyncTests.fs index fc17756520..5e54570bd8 100644 --- a/tests/Js/Main/AsyncTests.fs +++ b/tests/Js/Main/AsyncTests.fs @@ -169,6 +169,14 @@ let private fromGenericCallback (callback: ('T -> unit) -> (exn -> unit) -> (Ope let tests = testList "Async" [ + testCase "TryCancelled preserves success and ordinary errors" <| AsyncTryCancelled.successAndFailure + testCase "TryCancelled preserves cancellation identity and supports reuse" <| AsyncTryCancelled.cancellationIdentityAndReuse + testCase "TryCancelled installs nested handlers before cancellation" <| AsyncTryCancelled.preCancelledNesting + testCase "TryCancelled handles deferred cancellation" <| AsyncTryCancelled.deferredCancellation + testCase "TryCancelled preserves finalizer order when handlers throw" <| AsyncTryCancelled.finalizerOrdering + testCase "TryCancelled propagates downstream errors once" <| AsyncTryCancelled.downstreamExceptions + testCaseAsync "TryCancelled preserves bounded trampoline execution" <| AsyncTryCancelled.trampoline + testCase "TryFinally installs cleanup before pre-cancellation" <| FinalizerRegressions.preCancelled testCase "Pre-cancelled nested TryFinally only runs outer cleanup" <| FinalizerRegressions.nestedPreCancelled testCase "Cancelled acquisition disposes use and use bang resources" <| FinalizerRegressions.cancelledAcquisition diff --git a/tests/Js/Main/Fable.Tests.fsproj b/tests/Js/Main/Fable.Tests.fsproj index ce2d68b963..4e79b7ed52 100644 --- a/tests/Js/Main/Fable.Tests.fsproj +++ b/tests/Js/Main/Fable.Tests.fsproj @@ -41,6 +41,7 @@ + diff --git a/tests/Python/AsyncTryCancelled.fs b/tests/Python/AsyncTryCancelled.fs new file mode 100644 index 0000000000..61c0a61f6a --- /dev/null +++ b/tests/Python/AsyncTryCancelled.fs @@ -0,0 +1,148 @@ +module Fable.Tests.AsyncTryCancelled + +open System +open System.Threading + +let private check expected actual = + if expected <> actual then failwithf "Expected %A, got %A" expected actual + +let private runOffThreadPool action = +#if FABLE_COMPILER + action () +#else + // .NET reschedules deferred FromContinuations callbacks invoked on a pool thread. + // Use a dedicated thread so the probe can observe completion and thrown callbacks. + let mutable failure = None + let thread = Thread(ThreadStart(fun () -> + try action () + with error -> failure <- Some error)) + thread.Start() + thread.Join() + failure |> Option.iter raise +#endif + +let private observe token (work: Async) = + let calls = ResizeArray() + Async.StartWithContinuations( + work, + (fun value -> calls.Add(string value)), + (fun error -> calls.Add("error: " + error.Message)), + (fun error -> calls.Add("cancel: " + error.Message)), + token) + calls + +let successAndFailure () = + let mutable compensations = 0 + let wrap work = Async.TryCancelled(work, fun _ -> compensations <- compensations + 1) + check [|"42"|] ((observe CancellationToken.None (wrap (async.Return 42))).ToArray()) + for error in [Exception "body"; OperationCanceledException "thrown"] do + let work: Async = async { return raise error } + check [|"error: " + error.Message|] ((observe CancellationToken.None (wrap work)).ToArray()) + let mutable completed = false + Async.StartWithContinuations( + Async.TryCancelled(async.Return (), fun _ -> compensations <- compensations + 1), + (fun () -> completed <- true), raise, raise) + check true completed + check 0 compensations + +let cancellationIdentityAndReuse () = + for throws in [false; true] do + let original = OperationCanceledException "original" + let calls = ResizeArray() + let mutable handlerSawOriginal = true + let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel original) + let work = Async.TryCancelled(body, fun error -> + handlerSawOriginal <- handlerSawOriginal && obj.ReferenceEquals(original, error) + calls.Add "compensation" + if throws then failwith "compensation defect") + for _ in 1 .. 2 do + Async.StartWithContinuations(work, + (fun _ -> failwith "unexpected success"), + (fun _ -> failwith "unexpected error"), + (fun error -> + check true (obj.ReferenceEquals(original, error)) + calls.Add "cancel")) + check [|"compensation"; "cancel"; "compensation"; "cancel"|] (calls.ToArray()) + check true handlerSawOriginal + +let preCancelledNesting () = + use source = new CancellationTokenSource() + source.Cancel() + let mutable entered = false + let calls = ResizeArray() + let body = async { entered <- true; return 42 } + let inner = Async.TryCancelled(body, fun _ -> calls.Add "inner") + let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer") + Async.StartWithContinuations(outer, + (fun _ -> failwith "unexpected success"), raise, + (fun _ -> calls.Add "cancel"), source.Token) + check false entered + check [|"inner"; "outer"; "cancel"|] (calls.ToArray()) + +let deferredCancellation () = runOffThreadPool (fun () -> + let original = OperationCanceledException "deferred" + let mutable cancel = fun (_: OperationCanceledException) -> failwith "not started" + let calls = ResizeArray() + let body: Async = Async.FromContinuations(fun (_, _, continuation) -> cancel <- continuation) + let work = Async.TryCancelled(body, fun _ -> calls.Add "compensation") + Async.StartWithContinuations(work, + (fun _ -> failwith "unexpected success"), raise, + (fun error -> check true (obj.ReferenceEquals(original, error)); calls.Add "cancel")) + check 0 calls.Count + cancel original + check [|"compensation"; "cancel"|] (calls.ToArray())) + +let finalizerOrdering () = + let calls = ResizeArray() + let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel (OperationCanceledException "original")) + let finalized = async.TryFinally(body, fun () -> calls.Add "finally") + let inner = Async.TryCancelled(finalized, fun _ -> calls.Add "inner"; failwith "inner defect") + let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer"; failwith "outer defect") + check [|"cancel: original"|] ((observe CancellationToken.None outer).ToArray()) + check [|"finally"; "inner"; "outer"|] (calls.ToArray()) + +let downstreamExceptions () = runOffThreadPool (fun () -> + for channel in ["success"; "error"; "cancel"] do + let mutable compensations = 0 + let calls = ResizeArray() + let mutable complete = fun () -> failwith "not started" + let body: Async = Async.FromContinuations(fun (ok, error, cancel) -> + complete <- fun () -> + match channel with + | "success" -> ok 42 + | "error" -> error (Exception "body") + | _ -> cancel (OperationCanceledException "original")) + let work = Async.TryCancelled(body, fun _ -> compensations <- compensations + 1) + let terminal name = calls.Add name; failwith "downstream" + Async.StartWithContinuations(work, + (fun _ -> terminal "success"), + (fun _ -> terminal "error"), + (fun _ -> terminal "cancel")) + let caught = + try + complete () + "no exception" + with error -> error.Message + check "downstream" caught + check [|channel|] (calls.ToArray()) + check (if channel = "cancel" then 1 else 0) compensations) + +let trampoline () = async { + let original = OperationCanceledException "deep cancellation" + let mutable compensations = 0 + let rec loop remaining = + if remaining = 0 then + Async.FromContinuations(fun (_, _, cancel) -> cancel original) + else + Async.TryCancelled(async { + do! async.Return () + return! loop (remaining - 1) + }, fun _ -> compensations <- compensations + 1) + do! Async.FromContinuations(fun (ok, error, _) -> + Async.StartWithContinuations(loop 10000, + (fun () -> error (Exception "unexpected success")), error, + (fun cancelled -> + if obj.ReferenceEquals(original, cancelled) then ok () + else error (Exception "cancellation identity changed")))) + check 10000 compensations +} diff --git a/tests/Python/Fable.Tests.Python.fsproj b/tests/Python/Fable.Tests.Python.fsproj index b5f130a704..7ebe15a8f3 100644 --- a/tests/Python/Fable.Tests.Python.fsproj +++ b/tests/Python/Fable.Tests.Python.fsproj @@ -38,6 +38,7 @@ + diff --git a/tests/Python/TestAsync.fs b/tests/Python/TestAsync.fs index c41e74086c..6f486e7ee4 100644 --- a/tests/Python/TestAsync.fs +++ b/tests/Python/TestAsync.fs @@ -164,6 +164,34 @@ let errorWork: Async = Async.FromContinuations(fun (_,onError,_) -> onEr let cancelWork: Async = Async.FromContinuations(fun (_,_,onCancel) -> System.OperationCanceledException("cancelled") |> onCancel) +[] +let ``test TryCancelled preserves success and ordinary errors`` () = + AsyncTryCancelled.successAndFailure () + +[] +let ``test TryCancelled preserves cancellation identity and supports reuse`` () = + AsyncTryCancelled.cancellationIdentityAndReuse () + +[] +let ``test TryCancelled installs nested handlers before cancellation`` () = + AsyncTryCancelled.preCancelledNesting () + +[] +let ``test TryCancelled handles deferred cancellation`` () = + AsyncTryCancelled.deferredCancellation () + +[] +let ``test TryCancelled preserves finalizer order when handlers throw`` () = + AsyncTryCancelled.finalizerOrdering () + +[] +let ``test TryCancelled propagates downstream errors once`` () = + AsyncTryCancelled.downstreamExceptions () + +[] +let ``test TryCancelled preserves bounded trampoline execution`` () = + AsyncTryCancelled.trampoline () |> Async.RunSynchronously + [] let ``test Simple async translates without exception`` () = async { return () } diff --git a/tests/TypeScript/Fable.Tests.TypeScript.fsproj b/tests/TypeScript/Fable.Tests.TypeScript.fsproj index 40ecc987de..6402c5fa03 100644 --- a/tests/TypeScript/Fable.Tests.TypeScript.fsproj +++ b/tests/TypeScript/Fable.Tests.TypeScript.fsproj @@ -32,6 +32,7 @@ + From 22a7c97dae76c9c80fd301f685f3f4d3bcf06a08 Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Thu, 15 Oct 2026 22:52:41 +0200 Subject: [PATCH 2/4] ci: trigger build for Async.TryCancelled From b6ce1edbad276d0590176f581df5b0f6be0138b4 Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Thu, 15 Oct 2026 23:36:31 +0200 Subject: [PATCH 3/4] fix(python): preserve mutable callback type annotations --- src/Fable.Transforms/Python/Fable2Python.Transforms.fs | 7 ++++++- tests/Python/TestType.fs | 8 ++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs index 180e9855e1..4820be930b 100644 --- a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs +++ b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs @@ -1718,7 +1718,12 @@ let transformSet (com: IPythonCompiler) ctx range fableExpr typ (value: Fable.Ex let transformBindingExprBody (com: IPythonCompiler) (ctx: Context) (var: Fable.Ident) (value: Fable.Expr) = match value with | Function(args, body) -> - let name = Some var.Name + // decision: mutable callbacks keep their Callable annotation instead of inheriting a def's parameter names + let name = + if var.IsMutable then + None + else + Some var.Name let args', body', returnType, typeParams = Annotation.transformFunctionWithAnnotations com ctx name args body diff --git a/tests/Python/TestType.fs b/tests/Python/TestType.fs index 29e5416dcb..fc8d31ad32 100644 --- a/tests/Python/TestType.fs +++ b/tests/Python/TestType.fs @@ -772,6 +772,14 @@ let ``test Optional named params work`` () = StaticClass.NamedParams(foo="14") |> equal 11 StaticClass.NamedParams() |> equal "John is 30 years old" +[] +let ``test Mutable function bindings accept replacement callbacks`` () = + let mutable callback = fun (initial: int) -> initial + 1 + let replace (replacement: int -> int) = callback <- replacement + callback 3 |> equal 4 + replace (fun differentName -> differentName * 2) + callback 3 |> equal 6 + [] let ``test F# optional param works`` () = let mutable f1 = fun (v: bool) -> From 8d13685d034ba7f675038c8d14202f4f18daae1b Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Fri, 16 Oct 2026 00:05:54 +0200 Subject: [PATCH 4/4] test: move TryCancelled cases into target async suites --- tests/Beam/AsyncTests.fs | 138 +++++++++++++++- tests/Beam/Fable.Tests.Beam.fsproj | 1 - tests/Js/Main/AsyncTests.fs | 150 +++++++++++++++++- tests/Js/Main/Fable.Tests.fsproj | 1 - tests/Python/AsyncTryCancelled.fs | 148 ----------------- tests/Python/Fable.Tests.Python.fsproj | 1 - tests/Python/TestAsync.fs | 139 +++++++++++++++- .../TypeScript/Fable.Tests.TypeScript.fsproj | 1 - 8 files changed, 406 insertions(+), 173 deletions(-) delete mode 100644 tests/Python/AsyncTryCancelled.fs diff --git a/tests/Beam/AsyncTests.fs b/tests/Beam/AsyncTests.fs index 0985cf9002..364f65d769 100644 --- a/tests/Beam/AsyncTests.fs +++ b/tests/Beam/AsyncTests.fs @@ -5,35 +5,159 @@ open Fable.Tests.Util open Util.Testing open System.Threading +let private runOffThreadPool action = +#if FABLE_COMPILER + action () +#else + // .NET reschedules deferred FromContinuations callbacks invoked on a pool thread. + // Use a dedicated thread so the probe can observe completion and thrown callbacks. + let mutable failure = None + let thread = Thread(ThreadStart(fun () -> + try action () + with error -> failure <- Some error)) + thread.Start() + thread.Join() + failure |> Option.iter raise +#endif + +let private observeTryCancelled token (work: Async) = + let calls = ResizeArray() + Async.StartWithContinuations( + work, + (fun value -> calls.Add(string value)), + (fun error -> calls.Add("error: " + error.Message)), + (fun error -> calls.Add("cancel: " + error.Message)), + token) + calls + let private raiseCaughtCancellation (error: exn) : unit = raise error [] let ``test TryCancelled preserves success and ordinary errors`` () = - AsyncTryCancelled.successAndFailure () + let mutable compensations = 0 + let wrap work = Async.TryCancelled(work, fun _ -> compensations <- compensations + 1) + equal [|"42"|] ((observeTryCancelled CancellationToken.None (wrap (async.Return 42))).ToArray()) + for error in [Exception "body"; OperationCanceledException "thrown"] do + let work: Async = async { return raise error } + equal [|"error: " + error.Message|] ((observeTryCancelled CancellationToken.None (wrap work)).ToArray()) + let mutable completed = false + Async.StartWithContinuations( + Async.TryCancelled(async.Return (), fun _ -> compensations <- compensations + 1), + (fun () -> completed <- true), raise, raise) + equal true completed + equal 0 compensations [] let ``test TryCancelled preserves cancellation identity and supports reuse`` () = - AsyncTryCancelled.cancellationIdentityAndReuse () + for throws in [false; true] do + let original = OperationCanceledException "original" + let calls = ResizeArray() + let mutable handlerSawOriginal = true + let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel original) + let work = Async.TryCancelled(body, fun error -> + handlerSawOriginal <- handlerSawOriginal && obj.ReferenceEquals(original, error) + calls.Add "compensation" + if throws then failwith "compensation defect") + for _ in 1 .. 2 do + Async.StartWithContinuations(work, + (fun _ -> failwith "unexpected success"), + (fun _ -> failwith "unexpected error"), + (fun error -> + equal true (obj.ReferenceEquals(original, error)) + calls.Add "cancel")) + equal [|"compensation"; "cancel"; "compensation"; "cancel"|] (calls.ToArray()) + equal true handlerSawOriginal [] let ``test TryCancelled installs nested handlers before cancellation`` () = - AsyncTryCancelled.preCancelledNesting () + use source = new CancellationTokenSource() + source.Cancel() + let mutable entered = false + let calls = ResizeArray() + let body = async { entered <- true; return 42 } + let inner = Async.TryCancelled(body, fun _ -> calls.Add "inner") + let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer") + Async.StartWithContinuations(outer, + (fun _ -> failwith "unexpected success"), raise, + (fun _ -> calls.Add "cancel"), source.Token) + equal false entered + equal [|"inner"; "outer"; "cancel"|] (calls.ToArray()) [] let ``test TryCancelled handles deferred cancellation`` () = - AsyncTryCancelled.deferredCancellation () + runOffThreadPool (fun () -> + let original = OperationCanceledException "deferred" + let mutable cancel = fun (_: OperationCanceledException) -> failwith "not started" + let calls = ResizeArray() + let body: Async = Async.FromContinuations(fun (_, _, continuation) -> cancel <- continuation) + let work = Async.TryCancelled(body, fun _ -> calls.Add "compensation") + Async.StartWithContinuations(work, + (fun _ -> failwith "unexpected success"), raise, + (fun error -> equal true (obj.ReferenceEquals(original, error)); calls.Add "cancel")) + equal 0 calls.Count + cancel original + equal [|"compensation"; "cancel"|] (calls.ToArray())) [] let ``test TryCancelled preserves finalizer order when handlers throw`` () = - AsyncTryCancelled.finalizerOrdering () + let calls = ResizeArray() + let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel (OperationCanceledException "original")) + let finalized = async.TryFinally(body, fun () -> calls.Add "finally") + let inner = Async.TryCancelled(finalized, fun _ -> calls.Add "inner"; failwith "inner defect") + let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer"; failwith "outer defect") + equal [|"cancel: original"|] ((observeTryCancelled CancellationToken.None outer).ToArray()) + equal [|"finally"; "inner"; "outer"|] (calls.ToArray()) [] let ``test TryCancelled propagates downstream errors once`` () = - AsyncTryCancelled.downstreamExceptions () + runOffThreadPool (fun () -> + for channel in ["success"; "error"; "cancel"] do + let mutable compensations = 0 + let calls = ResizeArray() + let mutable complete = fun () -> failwith "not started" + let body: Async = Async.FromContinuations(fun (ok, error, cancel) -> + complete <- fun () -> + match channel with + | "success" -> ok 42 + | "error" -> error (Exception "body") + | _ -> cancel (OperationCanceledException "original")) + let work = Async.TryCancelled(body, fun _ -> compensations <- compensations + 1) + let terminal name = calls.Add name; failwith "downstream" + Async.StartWithContinuations(work, + (fun _ -> terminal "success"), + (fun _ -> terminal "error"), + (fun _ -> terminal "cancel")) + let caught = + try + complete () + "no exception" + with error -> error.Message + equal "downstream" caught + equal [|channel|] (calls.ToArray()) + equal (if channel = "cancel" then 1 else 0) compensations) [] let ``test TryCancelled preserves bounded trampoline execution`` () = - AsyncTryCancelled.trampoline () |> Async.RunSynchronously + async { + let original = OperationCanceledException "deep cancellation" + let mutable compensations = 0 + let rec loop remaining = + if remaining = 0 then + Async.FromContinuations(fun (_, _, cancel) -> cancel original) + else + Async.TryCancelled(async { + do! async.Return () + return! loop (remaining - 1) + }, fun _ -> compensations <- compensations + 1) + do! Async.FromContinuations(fun (ok, error, _) -> + Async.StartWithContinuations(loop 10000, + (fun () -> error (Exception "unexpected success")), error, + (fun cancelled -> + if obj.ReferenceEquals(original, cancelled) then ok () + else error (Exception "cancellation identity changed")))) + equal 10000 compensations + } + |> Async.RunSynchronously [] let ``test RunSynchronously optional timeout and cancellation token`` () = diff --git a/tests/Beam/Fable.Tests.Beam.fsproj b/tests/Beam/Fable.Tests.Beam.fsproj index 3342326a39..f310f1716d 100644 --- a/tests/Beam/Fable.Tests.Beam.fsproj +++ b/tests/Beam/Fable.Tests.Beam.fsproj @@ -74,7 +74,6 @@ - diff --git a/tests/Js/Main/AsyncTests.fs b/tests/Js/Main/AsyncTests.fs index e593f570c7..77a9965250 100644 --- a/tests/Js/Main/AsyncTests.fs +++ b/tests/Js/Main/AsyncTests.fs @@ -1,9 +1,35 @@ module Fable.Tests.Async open System +open System.Threading open Util open Util.Testing +let private runOffThreadPool action = +#if FABLE_COMPILER + action () +#else + // .NET reschedules deferred FromContinuations callbacks invoked on a pool thread. + // Use a dedicated thread so the probe can observe completion and thrown callbacks. + let mutable failure = None + let thread = Thread(ThreadStart(fun () -> + try action () + with error -> failure <- Some error)) + thread.Start() + thread.Join() + failure |> Option.iter raise +#endif + +let private observeTryCancelled token (work: Async) = + let calls = ResizeArray() + Async.StartWithContinuations( + work, + (fun value -> calls.Add(string value)), + (fun error -> calls.Add("error: " + error.Message)), + (fun error -> calls.Add("cancel: " + error.Message)), + token) + calls + module private FinalizerRegressions = open System open System.Threading @@ -169,13 +195,123 @@ let private fromGenericCallback (callback: ('T -> unit) -> (exn -> unit) -> (Ope let tests = testList "Async" [ - testCase "TryCancelled preserves success and ordinary errors" <| AsyncTryCancelled.successAndFailure - testCase "TryCancelled preserves cancellation identity and supports reuse" <| AsyncTryCancelled.cancellationIdentityAndReuse - testCase "TryCancelled installs nested handlers before cancellation" <| AsyncTryCancelled.preCancelledNesting - testCase "TryCancelled handles deferred cancellation" <| AsyncTryCancelled.deferredCancellation - testCase "TryCancelled preserves finalizer order when handlers throw" <| AsyncTryCancelled.finalizerOrdering - testCase "TryCancelled propagates downstream errors once" <| AsyncTryCancelled.downstreamExceptions - testCaseAsync "TryCancelled preserves bounded trampoline execution" <| AsyncTryCancelled.trampoline + testCase "TryCancelled preserves success and ordinary errors" <| fun () -> + let mutable compensations = 0 + let wrap work = Async.TryCancelled(work, fun _ -> compensations <- compensations + 1) + equal [|"42"|] ((observeTryCancelled CancellationToken.None (wrap (async.Return 42))).ToArray()) + for error in [Exception "body"; OperationCanceledException "thrown"] do + let work: Async = async { return raise error } + equal [|"error: " + error.Message|] ((observeTryCancelled CancellationToken.None (wrap work)).ToArray()) + let mutable completed = false + Async.StartWithContinuations( + Async.TryCancelled(async.Return (), fun _ -> compensations <- compensations + 1), + (fun () -> completed <- true), raise, raise) + equal true completed + equal 0 compensations + + testCase "TryCancelled preserves cancellation identity and supports reuse" <| fun () -> + for throws in [false; true] do + let original = OperationCanceledException "original" + let calls = ResizeArray() + let mutable handlerSawOriginal = true + let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel original) + let work = Async.TryCancelled(body, fun error -> + handlerSawOriginal <- handlerSawOriginal && obj.ReferenceEquals(original, error) + calls.Add "compensation" + if throws then failwith "compensation defect") + for _ in 1 .. 2 do + Async.StartWithContinuations(work, + (fun _ -> failwith "unexpected success"), + (fun _ -> failwith "unexpected error"), + (fun error -> + equal true (obj.ReferenceEquals(original, error)) + calls.Add "cancel")) + equal [|"compensation"; "cancel"; "compensation"; "cancel"|] (calls.ToArray()) + equal true handlerSawOriginal + + testCase "TryCancelled installs nested handlers before cancellation" <| fun () -> + use source = new CancellationTokenSource() + source.Cancel() + let mutable entered = false + let calls = ResizeArray() + let body = async { entered <- true; return 42 } + let inner = Async.TryCancelled(body, fun _ -> calls.Add "inner") + let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer") + Async.StartWithContinuations(outer, + (fun _ -> failwith "unexpected success"), raise, + (fun _ -> calls.Add "cancel"), source.Token) + equal false entered + equal [|"inner"; "outer"; "cancel"|] (calls.ToArray()) + + testCase "TryCancelled handles deferred cancellation" <| fun () -> + runOffThreadPool (fun () -> + let original = OperationCanceledException "deferred" + let mutable cancel = fun (_: OperationCanceledException) -> failwith "not started" + let calls = ResizeArray() + let body: Async = Async.FromContinuations(fun (_, _, continuation) -> cancel <- continuation) + let work = Async.TryCancelled(body, fun _ -> calls.Add "compensation") + Async.StartWithContinuations(work, + (fun _ -> failwith "unexpected success"), raise, + (fun error -> equal true (obj.ReferenceEquals(original, error)); calls.Add "cancel")) + equal 0 calls.Count + cancel original + equal [|"compensation"; "cancel"|] (calls.ToArray())) + + testCase "TryCancelled preserves finalizer order when handlers throw" <| fun () -> + let calls = ResizeArray() + let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel (OperationCanceledException "original")) + let finalized = async.TryFinally(body, fun () -> calls.Add "finally") + let inner = Async.TryCancelled(finalized, fun _ -> calls.Add "inner"; failwith "inner defect") + let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer"; failwith "outer defect") + equal [|"cancel: original"|] ((observeTryCancelled CancellationToken.None outer).ToArray()) + equal [|"finally"; "inner"; "outer"|] (calls.ToArray()) + + testCase "TryCancelled propagates downstream errors once" <| fun () -> + runOffThreadPool (fun () -> + for channel in ["success"; "error"; "cancel"] do + let mutable compensations = 0 + let calls = ResizeArray() + let mutable complete = fun () -> failwith "not started" + let body: Async = Async.FromContinuations(fun (ok, error, cancel) -> + complete <- fun () -> + match channel with + | "success" -> ok 42 + | "error" -> error (Exception "body") + | _ -> cancel (OperationCanceledException "original")) + let work = Async.TryCancelled(body, fun _ -> compensations <- compensations + 1) + let terminal name = calls.Add name; failwith "downstream" + Async.StartWithContinuations(work, + (fun _ -> terminal "success"), + (fun _ -> terminal "error"), + (fun _ -> terminal "cancel")) + let caught = + try + complete () + "no exception" + with error -> error.Message + equal "downstream" caught + equal [|channel|] (calls.ToArray()) + equal (if channel = "cancel" then 1 else 0) compensations) + + testCaseAsync "TryCancelled preserves bounded trampoline execution" <| fun () -> async { + let original = OperationCanceledException "deep cancellation" + let mutable compensations = 0 + let rec loop remaining = + if remaining = 0 then + Async.FromContinuations(fun (_, _, cancel) -> cancel original) + else + Async.TryCancelled(async { + do! async.Return () + return! loop (remaining - 1) + }, fun _ -> compensations <- compensations + 1) + do! Async.FromContinuations(fun (ok, error, _) -> + Async.StartWithContinuations(loop 10000, + (fun () -> error (Exception "unexpected success")), error, + (fun cancelled -> + if obj.ReferenceEquals(original, cancelled) then ok () + else error (Exception "cancellation identity changed")))) + equal 10000 compensations + } testCase "TryFinally installs cleanup before pre-cancellation" <| FinalizerRegressions.preCancelled testCase "Pre-cancelled nested TryFinally only runs outer cleanup" <| FinalizerRegressions.nestedPreCancelled diff --git a/tests/Js/Main/Fable.Tests.fsproj b/tests/Js/Main/Fable.Tests.fsproj index 4e79b7ed52..ce2d68b963 100644 --- a/tests/Js/Main/Fable.Tests.fsproj +++ b/tests/Js/Main/Fable.Tests.fsproj @@ -41,7 +41,6 @@ - diff --git a/tests/Python/AsyncTryCancelled.fs b/tests/Python/AsyncTryCancelled.fs deleted file mode 100644 index 61c0a61f6a..0000000000 --- a/tests/Python/AsyncTryCancelled.fs +++ /dev/null @@ -1,148 +0,0 @@ -module Fable.Tests.AsyncTryCancelled - -open System -open System.Threading - -let private check expected actual = - if expected <> actual then failwithf "Expected %A, got %A" expected actual - -let private runOffThreadPool action = -#if FABLE_COMPILER - action () -#else - // .NET reschedules deferred FromContinuations callbacks invoked on a pool thread. - // Use a dedicated thread so the probe can observe completion and thrown callbacks. - let mutable failure = None - let thread = Thread(ThreadStart(fun () -> - try action () - with error -> failure <- Some error)) - thread.Start() - thread.Join() - failure |> Option.iter raise -#endif - -let private observe token (work: Async) = - let calls = ResizeArray() - Async.StartWithContinuations( - work, - (fun value -> calls.Add(string value)), - (fun error -> calls.Add("error: " + error.Message)), - (fun error -> calls.Add("cancel: " + error.Message)), - token) - calls - -let successAndFailure () = - let mutable compensations = 0 - let wrap work = Async.TryCancelled(work, fun _ -> compensations <- compensations + 1) - check [|"42"|] ((observe CancellationToken.None (wrap (async.Return 42))).ToArray()) - for error in [Exception "body"; OperationCanceledException "thrown"] do - let work: Async = async { return raise error } - check [|"error: " + error.Message|] ((observe CancellationToken.None (wrap work)).ToArray()) - let mutable completed = false - Async.StartWithContinuations( - Async.TryCancelled(async.Return (), fun _ -> compensations <- compensations + 1), - (fun () -> completed <- true), raise, raise) - check true completed - check 0 compensations - -let cancellationIdentityAndReuse () = - for throws in [false; true] do - let original = OperationCanceledException "original" - let calls = ResizeArray() - let mutable handlerSawOriginal = true - let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel original) - let work = Async.TryCancelled(body, fun error -> - handlerSawOriginal <- handlerSawOriginal && obj.ReferenceEquals(original, error) - calls.Add "compensation" - if throws then failwith "compensation defect") - for _ in 1 .. 2 do - Async.StartWithContinuations(work, - (fun _ -> failwith "unexpected success"), - (fun _ -> failwith "unexpected error"), - (fun error -> - check true (obj.ReferenceEquals(original, error)) - calls.Add "cancel")) - check [|"compensation"; "cancel"; "compensation"; "cancel"|] (calls.ToArray()) - check true handlerSawOriginal - -let preCancelledNesting () = - use source = new CancellationTokenSource() - source.Cancel() - let mutable entered = false - let calls = ResizeArray() - let body = async { entered <- true; return 42 } - let inner = Async.TryCancelled(body, fun _ -> calls.Add "inner") - let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer") - Async.StartWithContinuations(outer, - (fun _ -> failwith "unexpected success"), raise, - (fun _ -> calls.Add "cancel"), source.Token) - check false entered - check [|"inner"; "outer"; "cancel"|] (calls.ToArray()) - -let deferredCancellation () = runOffThreadPool (fun () -> - let original = OperationCanceledException "deferred" - let mutable cancel = fun (_: OperationCanceledException) -> failwith "not started" - let calls = ResizeArray() - let body: Async = Async.FromContinuations(fun (_, _, continuation) -> cancel <- continuation) - let work = Async.TryCancelled(body, fun _ -> calls.Add "compensation") - Async.StartWithContinuations(work, - (fun _ -> failwith "unexpected success"), raise, - (fun error -> check true (obj.ReferenceEquals(original, error)); calls.Add "cancel")) - check 0 calls.Count - cancel original - check [|"compensation"; "cancel"|] (calls.ToArray())) - -let finalizerOrdering () = - let calls = ResizeArray() - let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel (OperationCanceledException "original")) - let finalized = async.TryFinally(body, fun () -> calls.Add "finally") - let inner = Async.TryCancelled(finalized, fun _ -> calls.Add "inner"; failwith "inner defect") - let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer"; failwith "outer defect") - check [|"cancel: original"|] ((observe CancellationToken.None outer).ToArray()) - check [|"finally"; "inner"; "outer"|] (calls.ToArray()) - -let downstreamExceptions () = runOffThreadPool (fun () -> - for channel in ["success"; "error"; "cancel"] do - let mutable compensations = 0 - let calls = ResizeArray() - let mutable complete = fun () -> failwith "not started" - let body: Async = Async.FromContinuations(fun (ok, error, cancel) -> - complete <- fun () -> - match channel with - | "success" -> ok 42 - | "error" -> error (Exception "body") - | _ -> cancel (OperationCanceledException "original")) - let work = Async.TryCancelled(body, fun _ -> compensations <- compensations + 1) - let terminal name = calls.Add name; failwith "downstream" - Async.StartWithContinuations(work, - (fun _ -> terminal "success"), - (fun _ -> terminal "error"), - (fun _ -> terminal "cancel")) - let caught = - try - complete () - "no exception" - with error -> error.Message - check "downstream" caught - check [|channel|] (calls.ToArray()) - check (if channel = "cancel" then 1 else 0) compensations) - -let trampoline () = async { - let original = OperationCanceledException "deep cancellation" - let mutable compensations = 0 - let rec loop remaining = - if remaining = 0 then - Async.FromContinuations(fun (_, _, cancel) -> cancel original) - else - Async.TryCancelled(async { - do! async.Return () - return! loop (remaining - 1) - }, fun _ -> compensations <- compensations + 1) - do! Async.FromContinuations(fun (ok, error, _) -> - Async.StartWithContinuations(loop 10000, - (fun () -> error (Exception "unexpected success")), error, - (fun cancelled -> - if obj.ReferenceEquals(original, cancelled) then ok () - else error (Exception "cancellation identity changed")))) - check 10000 compensations -} diff --git a/tests/Python/Fable.Tests.Python.fsproj b/tests/Python/Fable.Tests.Python.fsproj index 7ebe15a8f3..b5f130a704 100644 --- a/tests/Python/Fable.Tests.Python.fsproj +++ b/tests/Python/Fable.Tests.Python.fsproj @@ -38,7 +38,6 @@ - diff --git a/tests/Python/TestAsync.fs b/tests/Python/TestAsync.fs index b6aa840d63..6d8cd7002d 100644 --- a/tests/Python/TestAsync.fs +++ b/tests/Python/TestAsync.fs @@ -1,9 +1,35 @@ module Fable.Tests.Async open System +open System.Threading open Util open Util.Testing +let private runOffThreadPool action = +#if FABLE_COMPILER + action () +#else + // .NET reschedules deferred FromContinuations callbacks invoked on a pool thread. + // Use a dedicated thread so the probe can observe completion and thrown callbacks. + let mutable failure = None + let thread = Thread(ThreadStart(fun () -> + try action () + with error -> failure <- Some error)) + thread.Start() + thread.Join() + failure |> Option.iter raise +#endif + +let private observeTryCancelled token (work: Async) = + let calls = ResizeArray() + Async.StartWithContinuations( + work, + (fun value -> calls.Add(string value)), + (fun error -> calls.Add("error: " + error.Message)), + (fun error -> calls.Add("cancel: " + error.Message)), + token) + calls + module private FinalizerRegressions = open System open System.Threading @@ -166,31 +192,130 @@ let cancelWork: Async = Async.FromContinuations(fun (_,_,onCancel) -> [] let ``test TryCancelled preserves success and ordinary errors`` () = - AsyncTryCancelled.successAndFailure () + let mutable compensations = 0 + let wrap work = Async.TryCancelled(work, fun _ -> compensations <- compensations + 1) + equal [|"42"|] ((observeTryCancelled CancellationToken.None (wrap (async.Return 42))).ToArray()) + for error in [Exception "body"; OperationCanceledException "thrown"] do + let work: Async = async { return raise error } + equal [|"error: " + error.Message|] ((observeTryCancelled CancellationToken.None (wrap work)).ToArray()) + let mutable completed = false + Async.StartWithContinuations( + Async.TryCancelled(async.Return (), fun _ -> compensations <- compensations + 1), + (fun () -> completed <- true), raise, raise) + equal true completed + equal 0 compensations [] let ``test TryCancelled preserves cancellation identity and supports reuse`` () = - AsyncTryCancelled.cancellationIdentityAndReuse () + for throws in [false; true] do + let original = OperationCanceledException "original" + let calls = ResizeArray() + let mutable handlerSawOriginal = true + let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel original) + let work = Async.TryCancelled(body, fun error -> + handlerSawOriginal <- handlerSawOriginal && obj.ReferenceEquals(original, error) + calls.Add "compensation" + if throws then failwith "compensation defect") + for _ in 1 .. 2 do + Async.StartWithContinuations(work, + (fun _ -> failwith "unexpected success"), + (fun _ -> failwith "unexpected error"), + (fun error -> + equal true (obj.ReferenceEquals(original, error)) + calls.Add "cancel")) + equal [|"compensation"; "cancel"; "compensation"; "cancel"|] (calls.ToArray()) + equal true handlerSawOriginal [] let ``test TryCancelled installs nested handlers before cancellation`` () = - AsyncTryCancelled.preCancelledNesting () + use source = new CancellationTokenSource() + source.Cancel() + let mutable entered = false + let calls = ResizeArray() + let body = async { entered <- true; return 42 } + let inner = Async.TryCancelled(body, fun _ -> calls.Add "inner") + let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer") + Async.StartWithContinuations(outer, + (fun _ -> failwith "unexpected success"), raise, + (fun _ -> calls.Add "cancel"), source.Token) + equal false entered + equal [|"inner"; "outer"; "cancel"|] (calls.ToArray()) [] let ``test TryCancelled handles deferred cancellation`` () = - AsyncTryCancelled.deferredCancellation () + runOffThreadPool (fun () -> + let original = OperationCanceledException "deferred" + let mutable cancel = fun (_: OperationCanceledException) -> failwith "not started" + let calls = ResizeArray() + let body: Async = Async.FromContinuations(fun (_, _, continuation) -> cancel <- continuation) + let work = Async.TryCancelled(body, fun _ -> calls.Add "compensation") + Async.StartWithContinuations(work, + (fun _ -> failwith "unexpected success"), raise, + (fun error -> equal true (obj.ReferenceEquals(original, error)); calls.Add "cancel")) + equal 0 calls.Count + cancel original + equal [|"compensation"; "cancel"|] (calls.ToArray())) [] let ``test TryCancelled preserves finalizer order when handlers throw`` () = - AsyncTryCancelled.finalizerOrdering () + let calls = ResizeArray() + let body: Async = Async.FromContinuations(fun (_, _, cancel) -> cancel (OperationCanceledException "original")) + let finalized = async.TryFinally(body, fun () -> calls.Add "finally") + let inner = Async.TryCancelled(finalized, fun _ -> calls.Add "inner"; failwith "inner defect") + let outer = Async.TryCancelled(inner, fun _ -> calls.Add "outer"; failwith "outer defect") + equal [|"cancel: original"|] ((observeTryCancelled CancellationToken.None outer).ToArray()) + equal [|"finally"; "inner"; "outer"|] (calls.ToArray()) [] let ``test TryCancelled propagates downstream errors once`` () = - AsyncTryCancelled.downstreamExceptions () + runOffThreadPool (fun () -> + for channel in ["success"; "error"; "cancel"] do + let mutable compensations = 0 + let calls = ResizeArray() + let mutable complete = fun () -> failwith "not started" + let body: Async = Async.FromContinuations(fun (ok, error, cancel) -> + complete <- fun () -> + match channel with + | "success" -> ok 42 + | "error" -> error (Exception "body") + | _ -> cancel (OperationCanceledException "original")) + let work = Async.TryCancelled(body, fun _ -> compensations <- compensations + 1) + let terminal name = calls.Add name; failwith "downstream" + Async.StartWithContinuations(work, + (fun _ -> terminal "success"), + (fun _ -> terminal "error"), + (fun _ -> terminal "cancel")) + let caught = + try + complete () + "no exception" + with error -> error.Message + equal "downstream" caught + equal [|channel|] (calls.ToArray()) + equal (if channel = "cancel" then 1 else 0) compensations) [] let ``test TryCancelled preserves bounded trampoline execution`` () = - AsyncTryCancelled.trampoline () |> Async.RunSynchronously + async { + let original = OperationCanceledException "deep cancellation" + let mutable compensations = 0 + let rec loop remaining = + if remaining = 0 then + Async.FromContinuations(fun (_, _, cancel) -> cancel original) + else + Async.TryCancelled(async { + do! async.Return () + return! loop (remaining - 1) + }, fun _ -> compensations <- compensations + 1) + do! Async.FromContinuations(fun (ok, error, _) -> + Async.StartWithContinuations(loop 10000, + (fun () -> error (Exception "unexpected success")), error, + (fun cancelled -> + if obj.ReferenceEquals(original, cancelled) then ok () + else error (Exception "cancellation identity changed")))) + equal 10000 compensations + } + |> Async.RunSynchronously [] let ``test Simple async translates without exception`` () = diff --git a/tests/TypeScript/Fable.Tests.TypeScript.fsproj b/tests/TypeScript/Fable.Tests.TypeScript.fsproj index 6402c5fa03..40ecc987de 100644 --- a/tests/TypeScript/Fable.Tests.TypeScript.fsproj +++ b/tests/TypeScript/Fable.Tests.TypeScript.fsproj @@ -32,7 +32,6 @@ -