repair test of memory use

Fix a test to be less sensitive to the cost of non-tail recursion when
the goal is to check reachability of values from the current
continuation.

Related to #2963
This commit is contained in:
Matthew Flatt 2019-12-12 16:07:38 -07:00
parent bf41fee58d
commit 58f51f15ed

View File

@ -372,7 +372,7 @@
(provide go) (provide go)
(define (f x y) (define (f x y)
(let ([z (make-vector 1024 x)]) ; problem if `z` is retained during non-tail `(y)` (let ([z (make-vector 10240 x)]) ; problem if `z` is retained during non-tail `(y)`
(let ([w (cons x x)]) (let ([w (cons x x)])
(if (pair? x) (if (pair? x)
'ok ; SFS pass should clear `z` in or after this branch 'ok ; SFS pass should clear `z` in or after this branch
@ -382,11 +382,12 @@
(set! f f) (set! f f)
(define (go) (define (go)
(let loop ([n 100000]) (for ([i 100])
(f '(1 2) (lambda () (let loop ([n 1000])
(if (zero? n) (f '(1 2) (lambda ()
'done (if (zero? n)
(unbox (loop (sub1 n))))))))) 'done
(unbox (loop (sub1 n))))))))))
(unless (eq? 'cgc (system-type 'gc)) (unless (eq? 'cgc (system-type 'gc))
(let ([init-memory-use (current-memory-use)]) (let ([init-memory-use (current-memory-use)])
@ -399,7 +400,7 @@
(let loop () (let loop ()
(sleep 0.1) (sleep 0.1)
(define mu (current-memory-use)) (define mu (current-memory-use))
(printf "~s\n" mu) (printf "~s\n" (- mu init-memory-use))
(cond (cond
[(mu . < . (+ init-memory-use (* 100 1024 1024))) [(mu . < . (+ init-memory-use (* 100 1024 1024)))
(loop)] (loop)]