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.

pkgs/racket-test/tests/racket/place-channel.rkt

@@ -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,24 +391,17 @@
     (go 'terminate))
 
   ; test place-dead-evt
-  (define wbs '())
+  (let ([ths (for/list ([i (in-range 0 20)])
-  (for ([i (in-range 0 50)])
+               (define p (place ch (void (place-channel-get ch))))
-    (define p (place ch (void (place-channel-get ch))))
+               (thread
-    (set! wbs
+                (λ ()
-          (cons
+                  (define-values (in out) (place-channel))
-           (make-weak-box
+                  (place-channel-put p in)
-            (thread
+                  (sync
-             (λ ()
+                   (handle-evt (place-dead-evt p)
-               (define-values (in out) (place-channel))
+                               (lambda (x) (printf "Place ~a died\n" i) ))
-               (place-channel-put p in)
+                   out))))])
-               (sync 
+    (for-each sync ths))
-                 (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)))
 
   ; 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)
 

racket/src/racket/src/env.c

@@ -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) {

racket/src/racket/src/place.c

@@ -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);