FSharp.Control.AsyncSeq/iterAsyncParallel_cancellation_test.fsx at main · githubnext/FSharp.Control.AsyncSeq · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
#!/usr/bin/env dotnet fsi

// Test script to reproduce the iterAsyncParallel cancellation bug from Issue #122
// Run with: dotnet fsi iterAsyncParallel_cancellation_test.fsx

#r "./src/FSharp.Control.AsyncSeq/bin/Release/netstandard2.1/FSharp.Control.AsyncSeq.dll"

open System
open System.Threading
open FSharp.Control

// Reproduce the exact bug from Issue #122
let testCancellationBug() =
    printfn "Testing iterAsyncParallel cancellation bug..."

    let r = Random()

    let handle x = async {
        do! Async.Sleep (r.Next(200))
        printfn "%A" x
    }

    let fakeAsync = async {
        do! Async.Sleep 500
        return "hello"
    }

    let makeAsyncSeqBatch () =
        let rec loop() = asyncSeq {
            let! batch = fakeAsync |> Async.Catch
            match batch with
            | Choice1Of2 batch ->
                if (Seq.isEmpty batch) then
                    do! Async.Sleep 500
                    yield! loop()
                else
                    yield batch
                    yield! loop()
            | Choice2Of2 err ->
                 printfn "Problem getting batch: %A" err
        }
        loop()

    let x = makeAsyncSeqBatch () |> AsyncSeq.concatSeq |> AsyncSeq.iterAsyncParallel handle
    let exAsync = async {
        do! Async.Sleep 2000
        failwith "error"
    }

    // This should fail after 2 seconds when exAsync throws, but iterAsyncParallel may continue running
    let start = DateTime.Now
    try
        [x; exAsync] |> Async.Parallel |> Async.Ignore |> Async.RunSynchronously
        printfn "ERROR: Expected exception but completed normally"
    with
    | ex ->
        let elapsed = DateTime.Now - start
        printfn "Exception after %.1fs: %s" elapsed.TotalSeconds ex.Message
        if elapsed.TotalSeconds > 5.0 then
            printfn "ISSUE CONFIRMED: iterAsyncParallel failed to cancel properly (took %.1fs)" elapsed.TotalSeconds
        else
            printfn "OK: Cancellation worked correctly (took %.1fs)" elapsed.TotalSeconds

// Test with iterAsyncParallelThrottled as well
let testCancellationBugThrottled() =
    printfn "\nTesting iterAsyncParallelThrottled cancellation bug..."

    let handle x = async {
        do! Async.Sleep 100
        printfn "Processing: %A" x
    }

    let longRunningSequence = asyncSeq {
        for i in 1..1000 do
            do! Async.Sleep 50
            yield i
    }

    let x = longRunningSequence |> AsyncSeq.iterAsyncParallelThrottled 5 handle
    let exAsync = async {
        do! Async.Sleep 2000
        failwith "error"
    }

    let start = DateTime.Now
    try
        [x; exAsync] |> Async.Parallel |> Async.Ignore |> Async.RunSynchronously
        printfn "ERROR: Expected exception but completed normally"
    with
    | ex ->
        let elapsed = DateTime.Now - start
        printfn "Exception after %.1fs: %s" elapsed.TotalSeconds ex.Message
        if elapsed.TotalSeconds > 5.0 then
            printfn "ISSUE CONFIRMED: iterAsyncParallelThrottled failed to cancel properly (took %.1fs)" elapsed.TotalSeconds
        else
            printfn "OK: Cancellation worked correctly (took %.1fs)" elapsed.TotalSeconds

printfn "=== AsyncSeq iterAsyncParallel Cancellation Test ==="
testCancellationBug()
testCancellationBugThrottled()
printfn "=== Test Complete ==="