From d061970a0189d9ba1d4799576b3c59e2ce27aea4 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 21 Jun 2018 09:41:09 -0600
Subject: [PATCH] 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.
---
 .../tests/racket/place-channel.rkt            | 41 +++++++++----------
 racket/src/racket/src/env.c                   |  1 +
 racket/src/racket/src/place.c                 | 10 ++++-
 3 files changed, 29 insertions(+), 23 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/place-channel.rkt b/pkgs/racket-test/tests/racket/place-channel.rkt
index 4a5c35b851..a998a5fac5 100644
--- a/pkgs/racket-test/tests/racket/place-channel.rkt
+++ b/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 '())
-  (for ([i (in-range 0 50)])
-    (define p (place ch (void (place-channel-get ch))))
-    (set! wbs
-          (cons
-           (make-weak-box
-            (thread
-             (λ ()
-               (define-values (in out) (place-channel))
-               (place-channel-put p in)
-               (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)))
+  (let ([ths (for/list ([i (in-range 0 20)])
+               (define p (place ch (void (place-channel-get ch))))
+               (thread
+                (λ ()
+                  (define-values (in out) (place-channel))
+                  (place-channel-put p in)
+                  (sync
+                   (handle-evt (place-dead-evt p)
+                               (lambda (x) (printf "Place ~a died\n" i) ))
+                   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)
 
diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c
index a7a675e613..c61276c54e 100644
--- a/racket/src/racket/src/env.c
+++ b/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) {
diff --git a/racket/src/racket/src/place.c b/racket/src/racket/src/place.c
index 8e9187f0f2..012dc729a7 100644
--- a/racket/src/racket/src/place.c
+++ b/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);