與 MailboxProcessor 和 Task 的交互永遠掛起

Question

我想按順序處理一系列作業，但我想將這些作業並行排隊。

這是我的代碼：

open System.Threading.Tasks

let performWork (work : int) =
  task {
    do! Task.Delay 1000

    if work = 7 then
      failwith "Oh no"
    else
      printfn $"Work {work}"
  }

async {
  let w = MailboxProcessor.Start (fun inbox -> async {
    while true do
      let! message = inbox.Receive()

      let (ch : AsyncReplyChannel<_>), work = message

      do!
        performWork work
        |> Async.AwaitTask

      ch.Reply()
  })

  w.Error.Add(fun exn -> raise exn)

  let! completed =
    seq {
      for i = 1 to 10 do
        async {
          do! Async.Sleep 100
          do! w.PostAndAsyncReply(fun ch -> ch, i)

          return i
        }
    }
    |> fun jobs -> Async.Parallel(jobs, maxDegreeOfParallelism = 4)

  printfn $"Completed {Seq.length completed} job(s)."
}
|> Async.RunSynchronously

我希望這段代碼在到達工作項7時崩潰。

但是，它永遠掛起：

$ dotnet fsi ./Test.fsx
Work 3
Work 1
Work 2
Work 4
Work 5
Work 6

我認為w.Error事件沒有正確觸發。

我應該如何捕獲並重新拋出此錯誤？

如果我的工作是async的，那么它會按預期崩潰：

let performWork (work : int) =
  async {
    do! Async.Sleep 1000

    if work = 7 then
      failwith "Oh no"
    else
      printfn $"Work {work}"
  }

但我不明白為什么這很重要。

---

利用Result也可以，但同樣，我不知道為什么需要這樣做。

async {
  let w = MailboxProcessor.Start (fun inbox -> async {
    while true do
      let! message = inbox.Receive()

      let (ch : AsyncReplyChannel<_>), work = message

      try
        do!
          performWork work
          |> Async.AwaitTask

        ch.Reply(Ok ())
      with exn ->
        ch.Reply(Error exn)
  })

  let performWorkOnWorker (work : int) =
    async {
      let! outcome = w.PostAndAsyncReply(fun ch -> ch, work)

      match outcome with
      | Ok () ->
        return ()
      | Error exn ->
        return raise exn
    }

  let! completed =
    seq {
      for i = 1 to 10 do
        async {
          do! Async.Sleep 100
          do! performWorkOnWorker i

          return i
        }
    }
    |> fun jobs -> Async.Parallel(jobs, maxDegreeOfParallelism = 4)

  printfn $"Completed {Seq.length completed} job(s)."
}
|> Async.RunSynchronously

Answer 1

我認為問題出在您的錯誤處理中：

w.Error.Add(fun exn -> raise exn)

您沒有處理異常，而是試圖再次引發它，我認為這會導致無限循環。

您可以更改它以打印異常：

w.Error.Add(printfn "%A")

結果是：

Work 4
Work 2
Work 1
Work 3
Work 5
Work 6
System.AggregateException: One or more errors occurred. (Oh no)
 ---> System.Exception: Oh no
   at Program.performWork@4.MoveNext() in C:\Users\Brian Berns\Source\Repos\FsharpConsole\FsharpConsole\Program.fs:line 8
   --- End of inner exception stack trace ---

Answer 2

我認為這里“為什么”的要點是微軟在 .NET 4.5 中改變了“未觀察到”任務異常的行為，並將其引入 .NET 核心：這些異常不再導致進程終止，它們實際上是忽略。 您可以在此處閱讀更多相關信息。

我不知道Task和async如何互操作的來龍去脈，但似乎使用Task會導致繼續附加到它並因此在TaskScheduler上運行。 該異常作為MailboxProcessor中async計算的一部分被拋出，沒有任何東西“觀察”它。 這意味着異常以上述機制結束，這就是您的進程不再崩潰的原因。

您可以通過 .NET Framework 上的標志通過app.config更改此行為，如上面的鏈接中所述。 對於 .NET Core，你不能這樣做。 您通常會嘗試通過訂閱UnobservedTaskException事件並在那里重新拋出來復制它，但是在這種情況下這將不起作用，因為Task已掛起並且永遠不會被垃圾收集。

為了嘗試證明這一點，我修改了您的示例以包含PostAndReplyAsync的超時。 這意味着Task最終將完成，可以被垃圾收集，並且當終結器運行時，事件將被觸發。

open System
open System.Threading.Tasks

let performWork (work : int) =
  task {
    do! Task.Delay 1000

    if work = 7 then
      failwith "Oh no"
    else
      printfn $"Work {work}"
  }

let worker = async {
  let w = MailboxProcessor.Start (fun inbox -> async {
    while true do
      let! message = inbox.Receive()

      let (ch : AsyncReplyChannel<_>), work = message

      do!
        performWork work
        |> Async.AwaitTask

      ch.Reply()
  })

  w.Error.Add(fun exn -> raise exn)

  let! completed =
    seq {
      for i = 1 to 10 do
        async {
          do! Async.Sleep 100
          do! w.PostAndAsyncReply((fun ch -> ch, i), 10000)

          return i
        }
    }
    |> fun jobs -> Async.Parallel(jobs, maxDegreeOfParallelism = 4)

  printfn $"Completed {Seq.length completed} job(s)."

}

TaskScheduler.UnobservedTaskException.Add(fun ex ->
    printfn "UnobservedTaskException was fired, re-raising"
    raise ex.Exception)

try
  Async.RunSynchronously worker
with
  | :? TimeoutException -> ()

GC.Collect()
GC.WaitForPendingFinalizers()

我這里的output是：

Work 1
Work 3
Work 4
Work 2
Work 5
Work 6
UnobservedTaskException was fired, re-raising
Unhandled exception. System.AggregateException: A Task's exception(s) were not observed either by Waiting on the Task or accessing its Exception property. As a result, the unobserved exception was rethrown by the finalizer thread. (One or more errors occurred. (Oh no))
 ---> System.AggregateException: One or more errors occurred. (Oh no)
 ---> System.Exception: Oh no
   at Program.performWork@5.MoveNext() in /Users/cmager/dev/ConsoleApp1/ConsoleApp2/Program.fs:line 9
   --- End of inner exception stack trace ---
   at Microsoft.FSharp.Control.AsyncPrimitives.Start@1078-1.Invoke(ExceptionDispatchInfo edi)
   at Microsoft.FSharp.Control.Trampoline.Execute(FSharpFunc`2 firstAction) in D:\a\_work\1\s\src\fsharp\FSharp.Core\async.fs:line 104
   at Microsoft.FSharp.Control.AsyncPrimitives.AttachContinuationToTask@1144.Invoke(Task`1 completedTask) in D:\a\_work\1\s\src\fsharp\FSharp.Core\async.fs:line 1145
   at System.Threading.Tasks.ContinuationTaskFromResultTask`1.InnerInvoke()
   at System.Threading.Tasks.Task.<>c.<.cctor>b__272_0(Object obj)
   at System.Threading.ExecutionContext.RunInternal(ExecutionContext executionContext, ContextCallback callback, Object state)
--- End of stack trace from previous location ---
   at System.Threading.ExecutionContext.RunInternal(ExecutionContext executionContext, ContextCallback callback, Object state)
   at System.Threading.Tasks.Task.ExecuteWithThreadLocal(Task& currentTaskSlot, Thread threadPoolThread)
   --- End of inner exception stack trace ---
   at Program.clo@46-4.Invoke(UnobservedTaskExceptionEventArgs ex) in /Users/cmager/dev/ConsoleApp1/ConsoleApp2/Program.fs:line 48
   at Microsoft.FSharp.Control.CommonExtensions.SubscribeToObservable@1989.System.IObserver<'T>.OnNext(T args) in D:\a\_work\1\s\src\fsharp\FSharp.Core\async.fs:line 1990
   at Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers.h@379.Invoke(Object _arg1, TArgs args) in D:\a\_work\1\s\src\fsharp\FSharp.Core\seqcore.fs:line 379
   at Program.clo@46-3.Invoke(Object delegateArg0, UnobservedTaskExceptionEventArgs delegateArg1) in /Users/cmager/dev/ConsoleApp1/ConsoleApp2/Program.fs:line 46
   at System.Threading.Tasks.TaskScheduler.PublishUnobservedTaskException(Object sender, UnobservedTaskExceptionEventArgs ueea)
   at System.Threading.Tasks.TaskExceptionHolder.Finalize()

如您所見，異常最終由Task終結器發布，並在該處理程序中重新拋出它會導致應用程序關閉。

雖然很有趣，但我不確定這些信息是否實用。 在MailboxProcessor.Error處理程序中終止應用程序的建議可能是正確的。

Answer 3

據我所知，當您在 MailboxProcessor 主體中拋出異常時。 然后 MailboxProcessor 不會永遠掛起，它只會停止整個 MailboxProcessor。

您的程序也掛起，因為您執行了Async.Parallel並等待每個異步完成。 但是那些有異常的，永遠不會完成，或者返回結果。 因此，您的程序總體上會永遠掛起。

如果要顯式中止，則需要調用System.Environment.Exit ，而不僅僅是拋出異常。

重寫程序的一種方法是這樣的。

open System.Threading.Tasks

let performWork (work : int) = task {
    do! Task.Delay 1000

    if   work = 7
    then failwith "Oh no"
    else printfn $"Work {work}"
}

let mb =
    let mbBody (inbox : MailboxProcessor<AsyncReplyChannel<_> * int>) = async {
        while true do
            let! (ch,work) = inbox.Receive()
            try
                do! performWork work |> Async.AwaitTask
                ch.Reply ()
            with error  ->
                System.Environment.Exit 0
    }
    MailboxProcessor.Start mbBody

Async.RunSynchronously (async {
    let! completed =
        let jobs = [|
            for i = 1 to 10 do
                async {
                    do! Async.Sleep 100
                    do! mb.PostAndAsyncReply(fun ch -> ch, i)
                    return i
                }
        |]
        Async.Parallel(jobs)

    printfn $"Completed {Seq.length completed} job(s)."
})

順便提一句。 我將seq {}更改為數組，並額外刪除了maxDegreeOfParallelism選項。 否則，結果在我的測試中似乎不是很平行。 但如果你願意，你仍然可以保留那些。

執行這個程序會打印出如下內容：

Work 10
Work 4
Work 9
Work 3
Work 8