From 8f17913d55ef8573450a88c085b24072369fbf96 Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Sun, 2 Dec 2012 19:02:58 -0700 Subject: [PATCH] Fixed memory leak in making arrays strict: doing so wouldn't clear the reference to the original procedure, which itself could hold on to a lot of memory --- .../math/private/array/typed-array-struct.rkt | 28 +++++++++++-------- .../tests/strictness-memory-leak-test.rkt | 16 +++++++++++ 2 files changed, 33 insertions(+), 11 deletions(-) create mode 100644 collects/math/tests/strictness-memory-leak-test.rkt diff --git a/collects/math/private/array/typed-array-struct.rkt b/collects/math/private/array/typed-array-struct.rkt index a8df1228ca..565aea7b39 100644 --- a/collects/math/private/array/typed-array-struct.rkt +++ b/collects/math/private/array/typed-array-struct.rkt @@ -76,17 +76,23 @@ (: unsafe-build-array (All (A) (Indexes (Indexes -> A) -> (Array A)))) (define (unsafe-build-array ds f) - (define size (check-array-shape-size 'unsafe-build-array ds)) - (define: data : (U #f (Vectorof A)) #f) - (define (strict!) - (set! data (inline-build-array-data ds (λ (js j) (f js)) A))) - (define unsafe-proc - (λ: ([js : Indexes]) - (let ([data data]) - (if data - (unsafe-vector-ref data (unsafe-array-index->value-index ds js)) - (f js))))) - (Array ds size ((inst box Boolean) #f) strict! unsafe-proc)) + ;; This box's contents get replaced when the array we're constructing is made strict, so that + ;; the array stops referencing f. If we didn't do this, long chains of array computations would + ;; keep hold of references to all the intermediate procs, which is a memory leak. + (let ([f (box f)]) + (define size (check-array-shape-size 'unsafe-build-array ds)) + ;; Sharp readers might notice that strict! doesn't check to see whether the array is already + ;; strict; that's okay - array-strict! does it instead, which makes the "once strict, always + ;; strict" invariant easier to ensure in subtypes, which we don't always have control over + (define (strict!) + (let* ([old-f (unbox f)] + [vs (inline-build-array-data ds (λ (js j) (old-f js)) A)]) + ;; Make a new f that just indexes into vs + (set-box! f (λ: ([js : Indexes]) + (unsafe-vector-ref vs (unsafe-array-index->value-index ds js)))))) + (define unsafe-proc + (λ: ([js : Indexes]) ((unbox f) js))) + (Array ds size ((inst box Boolean) #f) strict! unsafe-proc))) (: unsafe-build-strict-array (All (A) (Indexes (Indexes -> A) -> (Array A)))) (define (unsafe-build-strict-array ds f) diff --git a/collects/math/tests/strictness-memory-leak-test.rkt b/collects/math/tests/strictness-memory-leak-test.rkt new file mode 100644 index 0000000000..7130861e21 --- /dev/null +++ b/collects/math/tests/strictness-memory-leak-test.rkt @@ -0,0 +1,16 @@ +#lang racket + +(require math/array + rackunit) + +;; Make a procedure that returns a random value to keep the optimizer from converting it to a +;; top-level, non-closure; if that happens, the module keeps a reference to it, which makes this +;; test always fail +(define bx (make-weak-box (let ([v (random)]) (λ (js) v)))) + +(define arr (build-array #() (weak-box-value bx))) + +;; Making `arr' strict should release the only remaining reference to the contents of `bx' +(array-strict! arr) +(collect-garbage) +(check-false (weak-box-value bx))