adjust place tests and failure mode

The places test suite included some tests that create lots of places
and don't wait for them, which can lead to an overload of places that
exhausts resources such as file descriptors. Improve the tests, and
also improve a failure behavior from a crash to an error message.
This commit is contained in:
Matthew Flatt 2018-06-21 09:41:09 -06:00
parent 8678fbc90c
commit d061970a01
3 changed files with 29 additions and 23 deletions

View File

@ -303,10 +303,10 @@
(for ([x (list 'p0val1 'p0val2 'p0val3)]) (place-channel-put out x))
(sleep 4)
(place-channel-put out 'p0val4)
(for ([p ps]) (place-wait p0))
(for ([p ps]) (place-wait p))
(place-wait p0)
(test (void) printf "signal-handle vector growing completes"))
(let ([pl (place-worker)])
(define flv1 (shared-flvector 0.0 1.0 2.0 3.0))
(define flv2 (make-shared-flvector 4 3.0))
@ -391,12 +391,8 @@
(go 'terminate))
; test place-dead-evt
(define wbs '())
(for ([i (in-range 0 50)])
(let ([ths (for/list ([i (in-range 0 20)])
(define p (place ch (void (place-channel-get ch))))
(set! wbs
(cons
(make-weak-box
(thread
(λ ()
(define-values (in out) (place-channel))
@ -404,11 +400,8 @@
(sync
(handle-evt (place-dead-evt p)
(lambda (x) (printf "Place ~a died\n" i) ))
out))))
wbs))
(collect-garbage)
(set! wbs (filter weak-box-value wbs))
(printf "len ~a\n" (length wbs)))
out))))])
(for-each sync ths))
; test deep stack handling in places_deep_copy c routine
(test-long (lambda (x) 3) "Listof ints")
@ -423,8 +416,9 @@
;; all count as "unreachable" when the place ends
(define (check-thread sync-ch)
(displayln "checking place-channel and thread GC interaction")
(let ([N 40])
(let ([N 20])
(define weaks (make-weak-hash))
(define places (make-hasheq))
(for ([i (in-range N)])
(define s (make-semaphore))
(hash-set!
@ -432,6 +426,7 @@
(thread (lambda ()
(define-values (i o) (place-channel))
(define p (place ch (place-channel-get ch)))
(hash-set! places p #t)
(place-channel-put p o)
(place-wait p)
(semaphore-post s)
@ -442,7 +437,9 @@
(sync (system-idle-evt))
(collect-garbage))
(unless ((hash-count weaks) . < . (/ N 2))
(error "thread-gc test failed"))))
(error "thread-gc test failed"))
(for ([p (in-hash-keys places)])
(place-wait p))))
(check-thread place-channel-get)
(check-thread sync)

View File

@ -554,6 +554,7 @@ Scheme_Env *scheme_place_instance_init(void *stack_base, struct NewGC *parent_gc
GC_construct_child_gc(parent_gc, memory_limit);
# endif
scheme_rktio = rktio_init();
if (!scheme_rktio) return NULL;
env = place_instance_init(stack_base, 0);
# if defined(MZ_PRECISE_GC)
if (scheme_rktio) {

View File

@ -523,6 +523,9 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
mzrt_sema_destroy(ready);
ready = NULL;
if (!place_data->place_obj)
scheme_signal_error("place: place creation failed");
log_place_event("id %d: create %" PRIdPTR, "create", 1, place_data->place_obj->id);
place_data->ready = NULL;
@ -2387,7 +2390,12 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
mem_limit = SCHEME_INT_VAL(place_data->cust_limit);
/* scheme_make_thread behaves differently if the above global vars are not null */
scheme_place_instance_init(stack_base, place_data->parent_gc, mem_limit);
if (!scheme_place_instance_init(stack_base, place_data->parent_gc, mem_limit)) {
/* setup failed (because we're out of some resource?); try to exit gracefully */
place_data->place_obj = NULL; /* reports failure */
mzrt_sema_post(place_data->ready);
return NULL;
}
a[0] = places_deep_direct_uncopy(place_data->current_library_collection_paths);
scheme_current_library_collection_paths(1, a);