Merge commit '564a92e8f18370577538ac913361e37edf8f2c95' into parallel_minor_gc_4_12

20 files changed, 181 insertions, 14 deletions

diff --git a/Changes b/Changes
index 633a7ca8b7..09361afbdf 100644
--- a/Changes
+++ b/Changes
@@ -37,6 +37,10 @@ OCaml 4.12.0
 
 ### Runtime system:
 
+- #2195: Improve error message in bytecode stack trace printing and load
+  debug information during bytecode startup if OCAMLRUNPARAM=b=2.
+  (David Allsopp, review by Gabriel Scherer and Xavier Leroy)
+
 - #9756: garbage collector colors change
   removes the gray color from the major gc
   (Sadiq Jaffer and Stephen Dolan reviewed by Xavier Leroy,
diff --git a/manual/manual/cmds/runtime.etex b/manual/manual/cmds/runtime.etex
index 771a44ccaf..0e9189dd89 100644
--- a/manual/manual/cmds/runtime.etex
+++ b/manual/manual/cmds/runtime.etex
@@ -112,8 +112,13 @@ The following environment variables are also consulted:
 \fi
   \begin{options}
   \item[b] (backtrace) Trigger the printing of a stack backtrace
-        when an uncaught exception aborts the program.
-        This option takes no argument.
+        when an uncaught exception aborts the program. An optional argument can
+        be provided: "b=0" turns backtrace printing off; "b=1" is equivalent to
+        "b" and turns backtrace printing on; "b=2" turns backtrace printing on
+        and forces the runtime system to load debugging information at program
+        startup time instead of at backtrace printing time. "b=2" can be used if
+        the runtime is unable to load debugging information at backtrace
+        printing time, for example if there are no file descriptors available.
   \item[p] (parser trace) Turn on debugging support for
         "ocamlyacc"-generated parsers.  When this option is on,
         the pushdown automaton that executes the parsers prints a
diff --git a/runtime/backtrace.c b/runtime/backtrace.c
index 2b6db83a63..800dcc7304 100644
--- a/runtime/backtrace.c
+++ b/runtime/backtrace.c
@@ -27,6 +27,7 @@
 #include "caml/backtrace_prim.h"
 #include "caml/fail.h"
 #include "caml/debugger.h"
+#include "caml/startup.h"
 
 void caml_init_backtrace(void)
 {
@@ -121,6 +122,38 @@ CAMLexport void caml_print_exception_backtrace(void)
       print_location(&li, i);
     }
   }
+
+  /* See also printexc.ml */
+  switch (caml_debug_info_status()) {
+  case FILE_NOT_FOUND:
+    fprintf(stderr,
+            "(Cannot print locations:\n "
+             "bytecode executable program file not found)\n");
+    break;
+  case BAD_BYTECODE:
+    fprintf(stderr,
+            "(Cannot print locations:\n "
+             "bytecode executable program file appears to be corrupt)\n");
+    break;
+  case WRONG_MAGIC:
+    fprintf(stderr,
+            "(Cannot print locations:\n "
+             "bytecode executable program file has wrong magic number)\n");
+    break;
+  case NO_FDS:
+    fprintf(stderr,
+            "(Cannot print locations:\n "
+             "bytecode executable program file cannot be opened;\n "
+             "-- too many open files. Try running with OCAMLRUNPARAM=b=2)\n");
+    break;
+  }
+}
+
+/* Return the status of loading backtrace information (error reporting in
+   bytecode) */
+CAMLprim value caml_ml_debug_info_status(value unit)
+{
+  return Val_int(caml_debug_info_status());
 }
 
 /* Get a copy of the latest backtrace */
diff --git a/runtime/backtrace_byt.c b/runtime/backtrace_byt.c
index 9146066e0f..909fe30e48 100644
--- a/runtime/backtrace_byt.c
+++ b/runtime/backtrace_byt.c
@@ -448,8 +448,9 @@ static void read_main_debug_info(struct debug_info *di)
   }
 
   fd = caml_attempt_open(&exec_name, &trail, 1);
-  if (fd < 0){
-    caml_fatal_error ("executable program file not found");
+  if (fd < 0) {
+    /* Record the failure of caml_attempt_open in di->already-read */
+    di->already_read = fd;
     CAMLreturn0;
   }
 
@@ -480,6 +481,8 @@ static void read_main_debug_info(struct debug_info *di)
     caml_close_channel(chan);
 
     di->events = process_debug_events(caml_start_code, events, &di->num_events);
+  } else {
+    close(fd);
   }
 
   CAMLreturn0;
@@ -491,11 +494,27 @@ CAMLexport void caml_init_debug_info(void)
   caml_add_debug_info(caml_start_code, Val_long(caml_code_size), Val_unit);
 }
 
+CAMLexport void caml_load_main_debug_info(void)
+{
+  if (caml_params->backtrace_enabled > 1) {
+    read_main_debug_info(caml_debug_info.contents[0]);
+  }
+}
+
 int caml_debug_info_available(void)
 {
   return (caml_debug_info.size != 0);
 }
 
+int caml_debug_info_status(void)
+{
+  if (!caml_debug_info_available()) {
+    return 0;
+  } else {
+    return ((struct debug_info *)caml_debug_info.contents[0])->already_read;
+  }
+}
+
 /* Search the event index for the given PC.  Return -1 if not found. */
 
 static struct ev_info *event_for_location(code_t pc)
diff --git a/runtime/backtrace_nat.c b/runtime/backtrace_nat.c
index 79dd6b7c79..c5b5a805f5 100644
--- a/runtime/backtrace_nat.c
+++ b/runtime/backtrace_nat.c
@@ -314,3 +314,8 @@ int caml_debug_info_available(void)
 {
   return 1;
 }
+
+int caml_debug_info_status(void)
+{
+  return 1;
+}
diff --git a/runtime/caml/backtrace.h b/runtime/caml/backtrace.h
index 0547ca5cd4..ef997c2dac 100644
--- a/runtime/caml/backtrace.h
+++ b/runtime/caml/backtrace.h
@@ -109,6 +109,7 @@ CAMLextern char_os * caml_cds_file;
  * different prototype. */
 extern void caml_stash_backtrace(value exn, value * sp, int reraise);
 
+CAMLextern void caml_load_main_debug_info(void);
 #endif
 
 
diff --git a/runtime/caml/backtrace_prim.h b/runtime/caml/backtrace_prim.h
index 9740ef61b0..38e6c06d2f 100644
--- a/runtime/caml/backtrace_prim.h
+++ b/runtime/caml/backtrace_prim.h
@@ -52,6 +52,12 @@ typedef void * debuginfo;
  * Relevant for bytecode, always true for native code. */
 int caml_debug_info_available(void);
 
+/* Check load status of debug information for the main program. This is always 1
+ * for native code. For bytecode, it is 1 if the debug information has been
+ * loaded, 0 if it has not been loaded or one of the error constants in
+ * startup.h if something went wrong loading the debug information. */
+int caml_debug_info_status(void);
+
 /* Return debuginfo associated to a slot or NULL. */
 debuginfo caml_debuginfo_extract(backtrace_slot slot);
 
diff --git a/runtime/caml/startup.h b/runtime/caml/startup.h
index 44d3457be4..e66b76ae3b 100644
--- a/runtime/caml/startup.h
+++ b/runtime/caml/startup.h
@@ -36,7 +36,8 @@ CAMLextern value caml_startup_code_exn(
   int pooling,
   char_os **argv);
 
-enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2, WRONG_MAGIC = -3 };
+/* These enum members should all be negative */
+enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2, WRONG_MAGIC = -3, NO_FDS = -4 };
 
 extern int caml_attempt_open(char_os **name, struct exec_trailer *trail,
                              int do_open_script);
diff --git a/runtime/caml/startup_aux.h b/runtime/caml/startup_aux.h
index a5768d4e56..bd41d6a44b 100644
--- a/runtime/caml/startup_aux.h
+++ b/runtime/caml/startup_aux.h
@@ -52,7 +52,7 @@ struct caml_params {
   uintnat init_max_stack_wsz;
   uintnat init_fiber_wsz;
 
-  uintnat backtrace_enabled_init;
+  uintnat backtrace_enabled;
   uintnat runtime_warnings;
   uintnat cleanup_on_exit;
 };
diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c
index cca360c3ff..aa5a0b9ba6 100644
--- a/runtime/startup_aux.c
+++ b/runtime/startup_aux.c
@@ -97,7 +97,7 @@ void caml_parse_ocamlrunparam(void)
     while (*opt != '\0'){
       switch (*opt++){
       //case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break;
-      case 'b': scanmult (opt, &params.backtrace_enabled_init); break;
+      case 'b': scanmult (opt, &params.backtrace_enabled); break;
       case 'c': scanmult (opt, &params.cleanup_on_exit); break;
       case 'e': scanmult (opt, &params.eventlog_enabled); break;
       case 'f': scanmult (opt, &params.init_fiber_wsz); break;
@@ -236,7 +236,7 @@ int caml_parse_command_line(char_os **argv)
       exit(0);
       break;
     case 'b':
-      params.backtrace_enabled_init = 1;
+      params.backtrace_enabled = 1;
       break;
     case 'I':
       if (argv[i + 1] != NULL) {
diff --git a/runtime/startup_byt.c b/runtime/startup_byt.c
index 43e3ef8de6..0f51fb8730 100644
--- a/runtime/startup_byt.c
+++ b/runtime/startup_byt.c
@@ -17,6 +17,7 @@
 
 /* Start-up code */
 
+#include <errno.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
@@ -127,7 +128,10 @@ int caml_attempt_open(char_os **name, struct exec_trailer *trail,
   if (fd == -1) {
     caml_stat_free(truename);
     caml_gc_message(0x100, "Cannot open file\n");
-    return FILE_NOT_FOUND;
+    if (errno == EMFILE)
+      return NO_FDS;
+    else
+      return FILE_NOT_FOUND;
   }
   if (!do_open_script) {
     err = read (fd, buf, 2);
@@ -335,7 +339,7 @@ CAMLexport void caml_main(char_os **argv)
   /* Initialize the abstract machine */
   caml_init_gc ();
   Caml_state->external_raise = NULL;
-  if (caml_params->backtrace_enabled_init) caml_record_backtrace(Val_int(1));
+  if (caml_params->backtrace_enabled) caml_record_backtrace(Val_int(1));
   /* Initialize the interpreter */
   caml_interprete(NULL, 0);
   /* Initialize the debugger, if needed */
@@ -363,6 +367,8 @@ CAMLexport void caml_main(char_os **argv)
   caml_stat_free(trail.section);
   /* Initialize system libraries */
   caml_sys_init(exe_name, argv + pos);
+  /* Load debugging info, if b>=2 */
+  caml_load_main_debug_info();
   /* ensure all globals are in major heap */
   caml_minor_collection();
 #ifdef _WIN32
@@ -421,7 +427,8 @@ CAMLexport value caml_startup_code_exn(
   if (exe_name == NULL) exe_name = caml_search_exe_in_path(argv[0]);
   Caml_state->external_raise = NULL;
   caml_sys_init(exe_name, argv);
-  if (caml_params->backtrace_enabled_init) caml_record_backtrace(Val_int(1));
+  /* Load debugging info, if b>=2 */
+  caml_load_main_debug_info();
   Caml_state->external_raise = NULL;
   /* Initialize the interpreter */
   caml_interprete(NULL, 0);
diff --git a/runtime/startup_nat.c b/runtime/startup_nat.c
index 542c6881d0..1085975a3f 100644
--- a/runtime/startup_nat.c
+++ b/runtime/startup_nat.c
@@ -111,7 +111,7 @@ value caml_startup_common(char_os **argv, int pooling)
   caml_init_custom_operations();
   caml_init_gc ();
 
-  if (caml_params->backtrace_enabled_init)
+  if (caml_params->backtrace_enabled)
     caml_record_backtrace(Val_int(1));
 
   init_segments();
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index 3394df406e..a7eb459d82 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -287,9 +287,31 @@ let exn_slot_name x =
   let slot = exn_slot x in
   (Obj.obj (Obj.field slot 0) : string)
 
+external get_debug_info_status : unit -> int = "caml_ml_debug_info_status"
+
+(* Descriptions for errors in startup.h. See also backtrace.c *)
+let errors = [| "";
+  (* FILE_NOT_FOUND *)
+  "(Cannot print locations:\n \
+      bytecode executable program file not found)";
+  (* BAD_BYTECODE *)
+  "(Cannot print locations:\n \
+      bytecode executable program file appears to be corrupt)";
+  (* WRONG_MAGIC *)
+  "(Cannot print locations:\n \
+      bytecode executable program file has wrong magic number)";
+  (* NO_FDS *)
+  "(Cannot print locations:\n \
+      bytecode executable program file cannot be opened;\n \
+      -- too many open files. Try running with OCAMLRUNPARAM=b=2)"
+|]
+
 let default_uncaught_exception_handler exn raw_backtrace =
   eprintf "Fatal error: exception %s\n" (to_string exn);
   print_raw_backtrace stderr raw_backtrace;
+  let status = get_debug_info_status () in
+  if status < 0 then
+    prerr_endline errors.(abs status);
   flush stderr
 
 let uncaught_exception_handler = ref default_uncaught_exception_handler
diff --git a/testsuite/tests/backtrace/pr2195-locs.byte.reference b/testsuite/tests/backtrace/pr2195-locs.byte.reference
new file mode 100644
index 0000000000..a39e776277
--- /dev/null
+++ b/testsuite/tests/backtrace/pr2195-locs.byte.reference
@@ -0,0 +1,4 @@
+Fatal error: exception Stdlib.Exit
+Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 417, characters 28-54
+Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19
+Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41
diff --git a/testsuite/tests/backtrace/pr2195-nolocs.byte.reference b/testsuite/tests/backtrace/pr2195-nolocs.byte.reference
new file mode 100644
index 0000000000..40d8e5a6c6
--- /dev/null
+++ b/testsuite/tests/backtrace/pr2195-nolocs.byte.reference
@@ -0,0 +1,6 @@
+Fatal error: exception Stdlib.Exit
+Raised by primitive operation at unknown location
+Called from unknown location
+(Cannot print locations:
+ bytecode executable program file cannot be opened;
+ -- too many open files. Try running with OCAMLRUNPARAM=b=2)
diff --git a/testsuite/tests/backtrace/pr2195.ml b/testsuite/tests/backtrace/pr2195.ml
new file mode 100644
index 0000000000..e0442a3405
--- /dev/null
+++ b/testsuite/tests/backtrace/pr2195.ml
@@ -0,0 +1,29 @@
+(* TEST
+   flags += "-g"
+   exit_status = "2"
+   * bytecode
+     ocamlrunparam += ",b=0"
+     reference = "${test_source_directory}/pr2195-nolocs.byte.reference"
+   * bytecode
+     ocamlrunparam += ",b=1"
+     reference = "${test_source_directory}/pr2195-nolocs.byte.reference"
+   * bytecode
+     ocamlrunparam += ",b=2"
+     reference = "${test_source_directory}/pr2195-locs.byte.reference"
+   * native
+     reference = "${test_source_directory}/pr2195.opt.reference"
+     compare_programs = "false"
+*)
+
+let () =
+  Printexc.record_backtrace true;
+  let c = open_out "foo" in
+  close_out c;
+  try
+    while true do
+      open_in "foo" |> ignore
+    done
+  with Sys_error _ ->
+    (* The message is platform-specific, so convert the exception to Exit *)
+    let bt = Printexc.get_raw_backtrace () in
+    Printexc.raise_with_backtrace Exit bt
diff --git a/testsuite/tests/backtrace/pr2195.opt.reference b/testsuite/tests/backtrace/pr2195.opt.reference
new file mode 100644
index 0000000000..15e1173e6c
--- /dev/null
+++ b/testsuite/tests/backtrace/pr2195.opt.reference
@@ -0,0 +1,5 @@
+Fatal error: exception Stdlib.Exit
+Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 417, characters 28-54
+Called from Stdlib.open_in in file "stdlib.ml" (inlined), line 422, characters 2-45
+Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19
+Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41
diff --git a/testsuite/tests/backtrace/pr2195.run b/testsuite/tests/backtrace/pr2195.run
new file mode 100755
index 0000000000..1dc6d478f6
--- /dev/null
+++ b/testsuite/tests/backtrace/pr2195.run
@@ -0,0 +1,9 @@
+#!/bin/sh
+
+# ulimit -n will have no effect on the Windows builds. The number of open files
+# on Windows is theoretically limited by available memory only, however the CRT
+# is limited to 8192 open files (including the standard handles).
+ulimit -n 32
+
+${program} > ${output} 2>&1
+echo 'exit_status="'$?'"' > ${ocamltest_response}
diff --git a/tools/ci/inria/other-configs/Jenkinsfile b/tools/ci/inria/other-configs/Jenkinsfile
index 1e30fc5aa8..7eaab11b4d 100644
--- a/tools/ci/inria/other-configs/Jenkinsfile
+++ b/tools/ci/inria/other-configs/Jenkinsfile
@@ -19,7 +19,9 @@
 
 pipeline {
   agent { label 'ocaml-linux-64' }
-  timeout(time: 2, unit: 'MINUTES') {
+  options {
+    timeout(time: 45, unit: 'MINUTES')
+  }
   stages {
     stage('Testing various other compiler configurations') {
       steps {
@@ -27,7 +29,6 @@ pipeline {
       }
     }
   }
-  }
   post {
     regression {
       emailext (
diff --git a/tools/ci/inria/sanitizers/script b/tools/ci/inria/sanitizers/script
index 5f8e5b6e7a..61081e37a2 100755
--- a/tools/ci/inria/sanitizers/script
+++ b/tools/ci/inria/sanitizers/script
@@ -122,6 +122,16 @@ git clean -q -f -d -x
 # Build the system
 make $jobs
 
+# ThreadSanitizer has problems with processes that exit via
+# pthread_exit in the last thread.
+# It also reports errors for the error case of unlocking an
+# error-checking mutex.
+# Exclude the corresponding test
+export OCAMLTEST_SKIP_TESTS="$OCAMLTEST_SKIP_TESTS \
+tests/lib-threads/pr9971.ml \
+tests/statmemprof/thread_exit_in_callback.ml \
+tests/lib-threads/mutex_errors.ml"
+
 # Run the testsuite.
 # ThreadSanitizer complains about fork() in threaded programs,
 # we ask it to just continue in this case.