Task.WhenAll遇异常永不终止，求符合预期的替代方案

我原本预期以下代码会在1秒后崩溃，但它始终没有终止：

open System
open System.Threading.Tasks

let foo () =
  task {
    do! Task.Delay(1_000_000)
    return 1
  }

let bar () =
  task {
    do! Task.Delay(1_000)
    raise (Exception "KABOOM")
    return 3
  }

let main () =
  task {
    do! Task.Delay(100)
    let! results = Task.WhenAll(foo (), bar ())
    return Seq.sum results
  }

main ()
|> fun t -> t.Result
|> printfn "%i"

1. 这一现象的原因是什么？ #

Task.WhenAll的设计逻辑是等待所有传入的任务完成（无论成功还是失败），只有当所有任务都结束后，才会将所有异常包装成AggregateException抛出。在你的代码里，bar()确实会在1秒后抛出异常，但foo()的延迟是1000000毫秒（约16分钟），主线程会一直等待foo()执行完毕，才会触发Task.WhenAll的异常逻辑，所以看起来程序始终没有终止。

而你提供的Async版本代码符合预期，是因为Async.Parallel的行为不同：它只要检测到任何一个异步操作失败，就会立即终止所有其他操作并抛出异常，不需要等待所有任务完成。Async代码如下：

open System

let foo () =
  async {
    do! Async.Sleep(1_000_000)
    return 1
  }

let bar () =
  async {
    do! Async.Sleep(1_000)
    raise (Exception "KABOOM")
    return 3
  }

let main () =
  async {
    do! Async.Sleep(100)
    let! results = Async.Parallel([ foo (); bar () ])
    return Seq.sum results
  }

main ()
|> Async.RunSynchronously
|> printfn "%i"

2. 是否存在符合预期的Task.WhenAll替代方案？ #

有几种方案可以实现“任一任务失败就立即终止并抛出异常”的效果：

方案1：结合Task.WhenAny与取消令牌

当任何一个任务完成时，检查是否失败，如果失败就取消其他未完成的任务：

open System
open System.Threading
open System.Threading.Tasks

let foo (cts: CancellationTokenSource) =
  task {
    do! Task.Delay(1_000_000, cts.Token)
    return 1
  }

let bar () =
  task {
    do! Task.Delay(1_000)
    raise (Exception "KABOOM")
    return 3
  }

let main () =
  task {
    do! Task.Delay(100)
    use cts = new CancellationTokenSource()
    let tasks = [ foo cts; bar () ]
    // 等待第一个任务完成
    let! completedTask = Task.WhenAny(tasks)
    // 检查是否失败
    if completedTask.IsFaulted then
      // 取消其他任务
      cts.Cancel()
      // 抛出异常
      return! completedTask :> Task<int[]>
    else
      // 如果第一个任务成功，等待剩余任务（可根据需求调整逻辑）
      let remainingTasks = tasks |> List.filter (fun t -> t <> completedTask)
      let! remainingResults = Task.WhenAll(remainingTasks)
      let allResults = [completedTask.Result] @ remainingResults |> Array.ofList
      return Seq.sum allResults
  }

main ()
|> fun t -> t.Result
|> printfn "%i"

方案2：自定义实现类似Async.Parallel的逻辑

手动遍历任务，监听每个任务的完成状态，一旦有任务失败就取消其他任务并抛出异常：

open System
open System.Threading
open System.Threading.Tasks

let whenAllFailFast tasks =
  task {
    use cts = new CancellationTokenSource()
    let taskCompletionSources = tasks |> List.map (fun _ -> TaskCompletionSource<int>())
    // 为每个任务注册回调
    for (task, tcs) in List.zip tasks taskCompletionSources do
      task.ContinueWith(fun t ->
        if t.IsFaulted then
          // 取消所有任务
          cts.Cancel()
          tcs.SetException(t.Exception.InnerExceptions)
        elif t.IsCanceled then
          tcs.SetCanceled()
        else
          tcs.SetResult(t.Result)
      ) |> ignore
    // 等待所有TCS完成（只要有一个失败就会触发终止）
    let! results = Task.WhenAll(taskCompletionSources |> List.map (fun tcs -> tcs.Task))
    return results
  }

let foo () =
  task {
    do! Task.Delay(1_000_000)
    return 1
  }

let bar () =
  task {
    do! Task.Delay(1_000)
    raise (Exception "KABOOM")
    return 3
  }

let main () =
  task {
    do! Task.Delay(100)
    let! results = whenAllFailFast [foo (); bar ()]
    return Seq.sum results
  }

main ()
|> fun t -> t.Result
|> printfn "%i"

这两种方案都能实现“任一任务失败就立即终止”的效果，符合你最初的预期。

内容的提问来源于stack exchange，提问作者sdgfsdh