repair for system in thread that can be deactivated (#759)

The `system` primitive is intended to be like a `__collect_safe` foreign call, allowing other threads to perform a collection while waiting for the shell command to return. Its shell-command argument is allocated, however, so `system` needs a copy of its argument while its thread is deactivated.
cisco · Nov 21, 2023 · d7cc2cf · d7cc2cf
1 parent 0654a2d
commit d7cc2cf
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 3 deletions.
diff --git a/c/prim5.c b/c/prim5.c
@@ -711,16 +711,30 @@ static void s_showalloc(IBOOL show_dump, const char *outfn) {
 
 static ptr s_system(const char *s) {
   INT status;
+  char *s_arg;
 #ifdef PTHREADS
   ptr tc = get_thread_context();
 #endif
 
 #ifdef PTHREADS
-  if (DISABLECOUNT(tc) == FIX(0)) deactivate_thread(tc);
+  if (DISABLECOUNT(tc) == FIX(0)) {
+    /* copy `s` in case a GC happens */
+    uptr len = strlen(s) + 1;
+    s_arg = malloc(len);
+    if (s_arg == NULL)
+      S_error("system", "malloc failed");
+    memcpy(s_arg, s, len);
+    deactivate_thread(tc);
+  }
+#else
+  s_arg = (char *)s;
 #endif
-  status = SYSTEM(s);
+  status = SYSTEM(s_arg);
 #ifdef PTHREADS
-  if (DISABLECOUNT(tc) == FIX(0)) reactivate_thread(tc);
+  if (DISABLECOUNT(tc) == FIX(0)) {
+    reactivate_thread(tc);
+    free(s_arg);
+  }
 #endif
 
   if ((status == -1) && (errno != 0)) {

diff --git a/mats/unix.ms b/mats/unix.ms
@@ -704,3 +704,27 @@
             (close-port from-stderr))))
     )
 )
+
+(unless (or (windows?)
+            (not (threaded?)))
+  (mat thread-system
+    ;; check that when a thread is deactivated during `system`,
+    ;; the command that it's running isn't GCed
+    (let* ([count 50]
+           [ths
+            (let loop ([i count])
+              (cond
+                [(zero? i) '()]
+                [else
+                 (cons
+                  (fork-thread
+                   (lambda ()
+                     (let loop ([i 10])
+                       (unless (= i 0)
+                         (unless (zero?
+                                  (system (format "echo ~s > /dev/null"
+                                                  (make-string (random 4096) #\x))))
+                           (error 'system "FAILED"))
+                         (loop (sub1 i))))))
+                  (loop (sub1 i)))]))])
+      (= count (length (map thread-join ths))))))