Does Async.StartChild có rò rỉ bộ nhớ không?

Question

Khi tôi chạy thử nghiệm sau đây (được xây dựng với F # 2.0), tôi nhận được OutOfMemoryException. Nó mất khoảng 5 phút để đạt được ngoại lệ trên hệ thống của tôi (i7-920 6gb ram nếu nó đang chạy như quá trình x86), nhưng trong mọi trường hợp chúng ta có thể thấy bộ nhớ đang phát triển như thế nào trong trình quản lý tác vụ.

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...." 

Tôi không thấy gì sai với mã này và không thấy bất kỳ lý do nào cho việc phát triển bộ nhớ. Tôi đã thực hiện thay thế để đảm bảo các đối số của tôi hợp lệ:

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

Để thử nghiệm này hoạt động tốt mà không cần tiêu thụ bộ nhớ đáng kể. Thật không may tôi không có nhiều kinh nghiệm trong F # và có nghi ngờ nếu tôi bỏ lỡ một số điều. Trong trường hợp nếu nó là lỗi làm thế nào tôi có thể báo cáo cho nhóm F #?

Answer 1

Tôi nghĩ bạn đã chính xác - dường như có rò rỉ bộ nhớ khi triển khai StartChild.

Tôi đã làm một chút hồ sơ (sau fantastic tutorial by Dave Thomas) và open-source F# release và tôi nghĩ rằng tôi thậm chí còn biết cách khắc phục điều đó. Nếu bạn nhìn vào việc thực hiện các StartChild, nó đăng ký một handler với token hủy hiện tại của công việc:

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

Đối tượng mà sống sót trong đống là trường hợp của chức năng đăng ký này. Chúng có thể không được đăng ký bằng cách gọi _reg.Dispose(), nhưng điều đó không bao giờ xảy ra trong mã nguồn F #. Tôi đã thử thêm _reg.Dispose() đến các chức năng mà có được gọi khi async hoàn thành:

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

... và dựa trên thí nghiệm của tôi, điều này sửa chữa vấn đề. Vì vậy, nếu bạn muốn giải pháp khác, bạn có thể sao chép tất cả mã bắt buộc từ control.fs và thêm mã này làm bản sửa lỗi.

Tôi sẽ gửi báo cáo lỗi cho nhóm F # với liên kết đến câu hỏi của bạn. Nếu bạn tìm thấy điều gì đó khác, bạn có thể liên hệ với họ bằng cách gửi báo cáo lỗi tới fsbugs tại microsoft dot com.