2012-01-28 9 views
15

次のテスト(F#2.0で構築)を実行すると、OutOfMemoryExceptionが発生します。私のシステム(x86プロセスとして動作していた場合はi7-920 6GB RAM)で例外に達するまでに約5分かかりますが、いずれにせよ、タスクマネージャでどのようにメモリが増えているかを見ることができます。Async.StartChildにメモリリークがありますか?

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#での経験はあまりありません。もしそれがバグであれば、どうすればF#チームに報告できますか?

答えて

15

私はあなたが正しいと思う - StartChildの実装でメモリリークがあるようです。

私は少しのプロファイリング(fantastic tutorial by Dave Thomasに従いました)とopen-source F# releaseを行って、私はそれを修正する方法を知っていると思います。あなたが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#チームに送信します。何か他のものが見つかった場合は、fsbugsmicrosoftのドットcomにバグレポートを送って連絡することができます。

+0

これはなぜ必要なのか分かりますか?なぜ新しい「CTS」が作られたのですか?元の 'ct'だけで十分ではないでしょうか? – svick

+0

@svick - 良い質問です。私は内部キャンセルトークンが 'StartChild'に指定できるタイムアウトを処理するために使用されると考えています(実際に結果を待たない限り、このタイムアウトは' StartChild'を呼び出す計算を取り消すべきではありません)。 –

+0

私はそれを考えなかった。うん、意味がある。 – svick

関連する問題