Disable test many-vectors-in-reasonable-space? for cgc (#2832)

This is currently failing in cgc:
     https://gitlab.com/racket/racket/-/jobs/303266624
This commit is contained in:
Paulo Matos 2019-09-25 14:47:46 +02:00 committed by GitHub
parent 6d7ae5e1d2
commit 3a46e41cde
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -386,25 +386,26 @@
'done 'done
(unbox (loop (sub1 n))))))))) (unbox (loop (sub1 n)))))))))
(let ([init-memory-use (current-memory-use)]) (unless (eq? 'cgc (system-type 'gc))
(define done? #f) (let ([init-memory-use (current-memory-use)])
(define t (thread (lambda () (define done? #f)
((dynamic-require ''allocates-many-vectors 'go)) (define t (thread (lambda ()
(set! done? #t)))) ((dynamic-require ''allocates-many-vectors 'go))
(define watcher-t (thread (set! done? #t))))
(lambda () (define watcher-t (thread
(let loop () (lambda ()
(sleep 0.1) (let loop ()
(define mu (current-memory-use)) (sleep 0.1)
(printf "~s\n" mu) (define mu (current-memory-use))
(cond (printf "~s\n" mu)
[(mu . < . (+ init-memory-use (* 100 1024 1024))) (cond
(loop)] [(mu . < . (+ init-memory-use (* 100 1024 1024)))
[else (loop)]
(kill-thread t)]))))) [else
(sync t) (kill-thread t)])))))
(kill-thread watcher-t) (sync t)
(test #t 'many-vectors-in-reasonable-space? done?)) (kill-thread watcher-t)
(test #t 'many-vectors-in-reasonable-space? done?)))
;; ---------------------------------------- ;; ----------------------------------------
;; Check that a thread that has a reference to ;; Check that a thread that has a reference to