Async.StartChild是否有内存泄漏？

Question

当我运行以下测试(使用F#2.0构建)时,我得到OutOfMemoryException.在我的系统上达到异常需要大约5分钟(如果它作为x86进程运行,则为i7-920 6gb ram),但无论如何我们都可以看到内存在任务管理器中的增长情况.

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)
            )
        }

对于此测试,它运行良好,没有任何相当大的内存消耗 不幸的是,我对F#没有多少经验,如果我错过了一些东西就会有疑问.如果是bug,我该如何向F#团队报告？

Answer 1

我认为你是对的 - 在执行中似乎存在内存泄漏StartChild.

我做了一些分析(遵循Dave Thomas的精彩教程)和开源F#版本,我想我甚至知道如何解决这个问题.如果查看实现StartChild,它会使用工作流的当前取消令牌注册处理程序:

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

在堆中保持活动的对象是此注册函数的实例.它们可以通过调用取消注册_reg.Dispose(),但这在F#源代码中永远不会发生.我尝试添加_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点com.