flan run's program dies with flan, and a program killed by a signal ends flan run with 128 plus its number

bin/main.ml

@@ -954,11 +954,9 @@ let () =
          removes the executable and its work directory: the default action
          would end flan inside the wait with neither removed. SIGINT and
          SIGQUIT are ignored while the program runs, as [system] does, since
-         the terminal sends them to the program too. *)
+         the terminal sends them to the program too. A flan killed outright
-      let pid =
+         takes the program with it ([Spawn.dying]). *)
-        Unix.create_process exe (Array.of_list (exe :: prog_args))
+      let pid = Flan.Spawn.dying exe (Array.of_list (exe :: prog_args)) in
-          Unix.stdin Unix.stdout Unix.stderr
-      in
       let caught = ref None in
       let forward s =
         Sys.Signal_handle (fun _ ->
@@ -972,7 +970,7 @@ let () =
       let rec wait () =
         match Unix.waitpid [] pid with
         | _, Unix.WEXITED c -> c
-        | _, (Unix.WSIGNALED _ | Unix.WSTOPPED _) -> 255
+        | _, (Unix.WSIGNALED s | Unix.WSTOPPED s) -> 128 + Flan.Spawn.host_signal s
         | exception Unix.Unix_error (Unix.EINTR, _, _) -> wait ()
       in
       let code = wait () in

lib/build.ml

@@ -64,8 +64,18 @@ let workdir () =
     workdir_exit := Some d;
     let pid = Unix.getpid () in
     at_exit (fun () ->
-      if Unix.getpid () = pid then
+      if Unix.getpid () = pid then begin
-        try Unix.rmdir d with Unix.Unix_error _ -> ())
+        (* The dyn header [compile_c] leaves for every compile in the process
+           to include, and not a build's own: gone when it is all that is
+           left, kept beside a failed build's C that includes it. *)
+        (match Sys.readdir d with
+         | [| "flan_dyn.h" |] ->
+           (try Unix.unlink (Filename.concat d "flan_dyn.h")
+            with Unix.Unix_error _ -> ())
+         | _ -> ()
+         | exception Sys_error _ -> ());
+        try Unix.rmdir d with Unix.Unix_error _ -> ()
+      end)
   end;
   d
 

lib/dune

@@ -13,7 +13,7 @@
  ; only C the compiler itself is built from. See lib/dynload_stubs.c.
  (foreign_stubs
   (language c)
-  (names dynload_stubs))
+  (names dynload_stubs spawn_stubs))
  ; No (c_library_flags (-ldl)): since glibc 2.34 dlopen lives in libc itself
  ; and libdl is a stub, and naming it breaks the merged build -- the partial
  ; link -output-complete-obj performs cannot resolve -ldl, so `flan dev` in

lib/spawn.ml

@@ -0,0 +1,6 @@
+(** Starting a program that dies with this process; see spawn_stubs.c. *)
+
+external dying : string -> string array -> int = "flan_spawn_dying"
+
+(** The host number of an OCaml signal number. *)
+external host_signal : int -> int = "flan_host_signal"

lib/spawn_stubs.c

@@ -0,0 +1,58 @@
+/* Starting a program that dies with the process that started it.
+ *
+ * `flan run` builds a program, runs it and deletes it. A flan killed by
+ * SIGKILL runs nothing on the way out, so without this the program would go on
+ * running with nobody waiting for it. On Linux the child asks the kernel for
+ * SIGKILL when its parent dies, between the fork and the exec; elsewhere it is
+ * an ordinary fork and exec.
+ */
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+/* Exported by the runtime, declared only under CAML_INTERNALS. */
+extern int caml_convert_signal_number(int);
+#include <errno.h>
+#include <signal.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#ifdef __linux__
+#include <sys/prctl.h>
+#endif
+
+value flan_spawn_dying(value path, value argv) {
+  CAMLparam2(path, argv);
+  mlsize_t n = Wosize_val(argv), i;
+  char **args = malloc((n + 1) * sizeof(char *));
+  char *file = strdup(String_val(path));
+  pid_t parent = getpid(), pid;
+  if (args == NULL || file == NULL) caml_failwith("flan_spawn_dying: out of memory");
+  for (i = 0; i < n; i++) args[i] = strdup(String_val(Field(argv, i)));
+  args[n] = NULL;
+  pid = fork();
+  if (pid == 0) {
+    sigset_t none;
+    sigemptyset(&none);
+    sigprocmask(SIG_SETMASK, &none, NULL);
+#ifdef __linux__
+    prctl(PR_SET_PDEATHSIG, SIGKILL);
+    /* The parent may have died before the request was made. */
+    if (getppid() != parent) _exit(137);
+#endif
+    execv(file, args);
+    _exit(127);
+  }
+  for (i = 0; i < n; i++) free(args[i]);
+  free(args);
+  free(file);
+  if (pid < 0) caml_failwith(strerror(errno));
+  CAMLreturn(Val_int(pid));
+}
+
+/* OCaml numbers the signals it knows by negative constants; a shell's exit
+ * status wants the host's number. */
+value flan_host_signal(value s) {
+  return Val_int(caml_convert_signal_number(Int_val(s)));
+}

test/test_acceptance.ml

@@ -7316,6 +7316,15 @@ level "1"
       (Printf.sprintf "run %s" (Filename.quote nomain)) ~code:1
       ~says:[ "has no main"; "(defn main [] i32" ];
     Sys.remove nomain;
+    (* A program killed by a signal ends [flan run] with the shell's
+       128 + n for it, SIGSEGV's 139 here, not a flat 255. *)
+    let killed = Filename.concat scratch "killed.flan" in
+    Out_channel.with_open_bin killed (fun oc ->
+      output_string oc
+        "(declare-c raise [s i32] i32 \"raise\")\n(defn main [] i32 (raise 11))\n");
+    cli_case "run of a program killed by a signal exits 128 + n"
+      (Printf.sprintf "run %s" (Filename.quote killed)) ~code:139 ~says:[];
+    Sys.remove killed;
 
     (* Every row above that went through the pool has been forked; nothing
        after this point may look at [failures] until every one of them has