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:
parent
bf41fee58d
commit
58f51f15ed
|
@ -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)]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user