Asynchronous Async.StartChild是否存在内存泄漏？

当我运行以下测试（使用F#2.0构建）时，我得到了OutOfMemoryException。在我的系统上（i7-920 6gb ram，如果它是以x86进程运行的），大约需要5分钟才能达到异常，但在任何情况下，我们都可以在任务管理器中看到内存是如何增长的

module start_child_test
    open System
    open System.Diagnostics
    open System.Threading
    open System.Threading.Tasks

    let cnt = ref 0
    let sw = Stopwatch.StartNew()
    Async.RunSynchronously(async{
        while true do
            let! x = Async.StartChild(async{
                if (Interlocked.Increment(cnt) % 100000) = 0 then
                    if sw.ElapsedMilliseconds > 0L then
                        printfn "ops per sec = %d" (100000L*1000L / sw.ElapsedMilliseconds)
                    else
                        printfn "ops per sec = INF"
                    sw.Restart()
                    GC.Collect()
            })
            do! x
    })

    printfn "done...."

我看不出这段代码有什么问题，也看不出内存增长的任何原因。我进行了替代实现以确保我的参数有效：

module start_child_fix
    open System
    open System.Collections
    open System.Collections.Generic
    open System.Threading
    open System.Threading.Tasks


    type IAsyncCallbacks<'T> = interface
        abstract member OnSuccess: result:'T -> unit
        abstract member OnError: error:Exception -> unit
        abstract member OnCancel: error:OperationCanceledException -> unit
    end

    type internal AsyncResult<'T> = 
        | Succeeded of 'T
        | Failed of Exception
        | Canceled of OperationCanceledException

    type internal AsyncGate<'T> = 
        | Completed of AsyncResult<'T>
        | Subscribed of IAsyncCallbacks<'T>
        | Started
        | Notified

    type Async with
        static member StartChildEx (comp:Async<'TRes>) = async{
            let! ct = Async.CancellationToken

            let gate = ref AsyncGate.Started
            let CompleteWith(result:AsyncResult<'T>, callbacks:IAsyncCallbacks<'T>) =
                if Interlocked.Exchange(gate, Notified) <> Notified then
                    match result with
                        | Succeeded v -> callbacks.OnSuccess(v)
                        | Failed e -> callbacks.OnError(e)
                        | Canceled e -> callbacks.OnCancel(e)

            let ProcessResults (result:AsyncResult<'TRes>) =
                let t = Interlocked.CompareExchange<AsyncGate<'TRes>>(gate, AsyncGate.Completed(result), AsyncGate.Started)
                match t with
                | Subscribed callbacks -> 
                    CompleteWith(result, callbacks)
                | _ -> ()
            let Subscribe (success, error, cancel) = 
                let callbacks = {
                    new IAsyncCallbacks<'TRes> with
                        member this.OnSuccess v = success v
                        member this.OnError e = error e
                        member this.OnCancel e = cancel e
                }
                let t = Interlocked.CompareExchange<AsyncGate<'TRes>>(gate, AsyncGate.Subscribed(callbacks), AsyncGate.Started)
                match t with
                | AsyncGate.Completed result -> 
                    CompleteWith(result, callbacks)
                | _ -> ()

            Async.StartWithContinuations(
                computation = comp,
                continuation = (fun v -> ProcessResults(AsyncResult.Succeeded(v))),
                exceptionContinuation = (fun e -> ProcessResults(AsyncResult.Failed(e))),
                cancellationContinuation = (fun e -> ProcessResults(AsyncResult.Canceled(e))),
                cancellationToken = ct
            )
            return Async.FromContinuations( fun (success, error, cancel) ->
                Subscribe(success, error, cancel)
            )
        }

模块启动\u子\u修复
开放系统
开放系统。集合
open System.Collections.Generic
开放系统。线程
开放系统.Threading.Tasks
类型IAsyncCallbacks单元
抽象成员OnError:错误：异常->单位
抽象成员OnCancel:错误：OperationCanceledException->unit
结束
输入内部异步结果
|订阅的IAsyncCallbacks）=异步{
让！ct=Async.CancellationToken
let gate=ref AsyncGate.Started
让CompleteWith（结果：AsyncResult）=
如果联锁，则通知交换（门，通知）
匹配结果
|成功的v->callbacks.OnSuccess（v）
|e->回调失败。OneError（e）
|取消e->callbacks.OnCancel（e）
let ProcessResults（结果：AsyncResult>（门，AsyncGate.Completed（结果），AsyncGate.Started）
匹配
|订阅的回调->
CompleteWith（结果、回调）
| _ -> ()
让订阅（成功、错误、取消）=
让回调={
新建IAsyncCallbacks>（gate，AsyncGate.Subscribed（回调），AsyncGate.Started）
匹配
|AsyncGate.Completed结果->
CompleteWith（结果、回调）
| _ -> ()
Async.StartWithContinuations(
计算=补偿，
continuation=（fun v->ProcessResults（AsyncResult.successed（v）），
exceptionContinuation=（乐趣e->ProcessResults（AsyncResult.Failed（e）），
cancellationContinuation=（乐趣e->ProcessResults（AsyncResult.Cancelled（e）），
取消令牌=ct
)
返回Async.FromContinuations（乐趣（成功、错误、取消）->
订阅（成功、错误、取消）
)
}

---

对于这个测试，它工作得很好，没有明显的内存消耗。不幸的是，我在F方面没有太多经验，如果我错过了一些东西，我会有疑问。如果是bug，我如何向F团队报告它？

我想你是对的，

StartChild

的实现中似乎存在内存泄漏

我做了一些分析（遵循a）和，我想我甚至知道如何解决这个问题。如果您查看

StartChild

的实现，它会使用工作流的当前取消令牌注册一个处理程序：

let _reg = ct.Register(
    (fun _ -> 
        match !ctsRef with
        |   null -> ()
        |   otherwise -> otherwise.Cancel()), null)

堆中保持活动状态的对象是此已注册函数的实例。可以通过调用

\u reg.Dispose（）

来注销这些对象，但这在F源代码中从未发生过。我尝试将

\u reg.Dispose（）

添加到异步完成时调用的函数中：

(fun res -> _reg.Dispose(); ctsRef := null; resultCell.RegisterResult (Ok res, reuseThread=true))   
(fun err -> _reg.Dispose(); ctsRef := null; resultCell.RegisterResult (Error err,reuseThread=true))   
(fun err -> _reg.Dispose(); ctsRef := null; resultCell.RegisterResult (Canceled err,reuseThread=true))

…根据我的实验，这解决了问题。因此，如果您想要解决问题，您可以从

control.fs

复制所有必需的代码，并将其添加为解决方案

---

我将向F#团队发送一份错误报告，并附上您的问题的链接。如果您发现其他问题，您可以通过将错误报告发送到

fsbugs

与他们联系，地址是

microsoft

dot

com

您知道为什么需要这样做吗？为什么要创建一个新的

CTS

呢？不只是使用原始的

ct

吗nough？@svick-问得好。我认为内部取消令牌用于处理可以为

StartChild

指定的超时（此超时不应取消调用

StartChild

的计算，除非您稍后实际等待结果）。我没有想到。是的，这很有意义。@Tomas-你知道这个错误是否已经在F#3.0中修复了吗？刚刚在F#3.0的.Net 4.5中测试了start#u child#u test，似乎已经修复了：内存和堆大小几乎是恒定的，不会随时间增长。（i7、x64、16GB、Win8）