Improve legibility of dynamic linking error messages

Avoid wrapping a Dynlink `Cannot_open_dynamic_library` error into
another `Cannot_open_dynamic_library` error:
- rewrite the platform-specific (bytecode and native) `load`
  implementations to ensure they raise only `DT.Error` exceptions, by
  always catching other exceptions and wrapping them into
  `Cannot_open_dynamic_library` errors,
- remove the systematic wrapping of exceptions in `Dynlink_common`.

Adopt `%s` rather than `%S` to display the inner exceptions in the
exception printer for `DT.Error (Cannot_open_dynamic_library _)` to
avoid double escaping

In particular, trying to link a non-existent file in the native
implementation gives the hard-to-parse message:

  Fatal error: exception Dynlink.Error (Dynlink.Cannot_open_dll "Dynlink.Error (Dynlink.Cannot_open_dll \"Failure(\\\"...: cannot open shared object file: No such file or directory\\\")\")")

This patch turns this message into:

  Fatal error: exception Dynlink.Error (Dynlink.Cannot_open_dll Failure("...: cannot open shared object file: No such file or directory"))

9 files changed, 71 insertions, 59 deletions

diff --git a/Changes b/Changes
index cb25863e2a..40be5e7574 100644
--- a/Changes
+++ b/Changes
@@ -16,6 +16,9 @@ Working version
 
 ### Other libraries:
 
+- #12213: Dynlink library, improve legibility of error messages
+  (Samuel Hym, review by Gabriel Scherer and Nicolás Ojeda Bär)
+
 ### Tools:
 
 - #12185: New script language for ocamltest.
diff --git a/otherlibs/dynlink/byte/dynlink.ml b/otherlibs/dynlink/byte/dynlink.ml
index 2a520596a3..6a6ae1a907 100644
--- a/otherlibs/dynlink/byte/dynlink.ml
+++ b/otherlibs/dynlink/byte/dynlink.ml
@@ -151,10 +151,13 @@ module Bytecode = struct
         (Printexc.get_raw_backtrace ())
 
   let load ~filename:file_name ~priv:_ =
-    let ic = open_in_bin file_name in
-    let file_digest = Digest.channel ic (-1) in
-    seek_in ic 0;
+    let ic =
+      try open_in_bin file_name
+      with exc -> raise (DT.Error (Cannot_open_dynamic_library exc))
+    in
     try
+      let file_digest = Digest.channel ic (-1) in
+      seek_in ic 0;
       let buffer =
         try really_input_string ic (String.length Config.cmo_magic_number)
         with End_of_file -> raise (DT.Error (Not_a_bytecode_file file_name))
@@ -170,19 +173,23 @@ module Bytecode = struct
         let toc_pos = input_binary_int ic in  (* Go to table of contents *)
         seek_in ic toc_pos;
         let lib = (input_value ic : Cmo_format.library) in
-        begin try
-          Dll.open_dlls Dll.For_execution
-            (List.map Dll.extract_dll_name lib.lib_dllibs)
-        with exn ->
-          raise (DT.Error (Cannot_open_dynamic_library exn))
-        end;
+        Dll.open_dlls Dll.For_execution
+          (List.map Dll.extract_dll_name lib.lib_dllibs);
         handle, lib.lib_units
       end else begin
         raise (DT.Error (Not_a_bytecode_file file_name))
       end
-    with exc ->
-      close_in ic;
+    with
+    (* Wrap all exceptions into Cannot_open_dynamic_library errors except
+       Not_a_bytecode_file ones, as they bring all the necessary information
+       already
+       Use close_in_noerr since the exception we really want to raise is exc *)
+    | DT.Error _ as exc ->
+      close_in_noerr ic;
       raise exc
+    | exc ->
+      close_in_noerr ic;
+      raise (DT.Error (Cannot_open_dynamic_library exc))
 
   let unsafe_get_global_value ~bytecode_or_asm_symbol =
     let id = Ident.create_persistent bytecode_or_asm_symbol in
diff --git a/otherlibs/dynlink/dynlink_common.ml b/otherlibs/dynlink/dynlink_common.ml
index 6f4d8c0b4b..72e9e67303 100644
--- a/otherlibs/dynlink/dynlink_common.ml
+++ b/otherlibs/dynlink/dynlink_common.ml
@@ -346,30 +346,25 @@ module Make (P : Dynlink_platform_intf.S) = struct
   let load priv filename =
     init ();
     let filename = dll_filename filename in
-    match P.load ~filename ~priv with
-    | exception exn -> raise (DT.Error (Cannot_open_dynamic_library exn))
-    | handle, units ->
-      try
-        with_lock (fun ({unsafe_allowed; _ } as global) ->
-            global.state <- check filename units global.state
-                ~unsafe_allowed
-                ~priv;
-            P.run_shared_startup handle;
-          );
-        List.iter
-          (fun unit_header ->
-             (* Linked modules might call Dynlink themselves,
-                we need to release the lock *)
-             P.run Global.lock handle ~unit_header ~priv;
-             if not priv then with_lock (fun global ->
-                 global.state <- set_loaded filename unit_header global.state
-               )
-          )
-          units;
-        P.finish handle
-      with exn ->
-        P.finish handle;
-        raise exn
+    let handle, units = P.load ~filename ~priv in
+    Fun.protect ~finally:(fun () -> P.finish handle) (fun () ->
+      with_lock (fun ({unsafe_allowed; _ } as global) ->
+          global.state <- check filename units global.state
+              ~unsafe_allowed
+              ~priv;
+          P.run_shared_startup handle;
+        );
+      List.iter
+        (fun unit_header ->
+           (* Linked modules might call Dynlink themselves,
+              we need to release the lock *)
+           P.run Global.lock handle ~unit_header ~priv;
+           if not priv then with_lock (fun global ->
+               global.state <- set_loaded filename unit_header global.state
+             )
+        )
+        units
+      )
 
   let loadfile filename = load false filename
   let loadfile_private filename = load true filename
diff --git a/otherlibs/dynlink/dynlink_types.ml b/otherlibs/dynlink/dynlink_types.ml
index ebfd2d1cde..90e905dacd 100644
--- a/otherlibs/dynlink/dynlink_types.ml
+++ b/otherlibs/dynlink/dynlink_types.ml
@@ -101,7 +101,7 @@ let () =
       | Corrupted_interface s ->
         Printf.sprintf "Corrupted_interface %S" s
       | Cannot_open_dynamic_library exn ->
-        Printf.sprintf "Cannot_open_dll %S" (Printexc.to_string exn)
+        Printf.sprintf "Cannot_open_dll %s" (Printexc.to_string exn)
       | Inconsistent_implementation s ->
         Printf.sprintf "Inconsistent_implementation %S" s
       | Library's_module_initializers_failed exn ->
diff --git a/otherlibs/dynlink/native/dynlink.ml b/otherlibs/dynlink/native/dynlink.ml
index 7a46a07ee3..39f71522fa 100644
--- a/otherlibs/dynlink/native/dynlink.ml
+++ b/otherlibs/dynlink/native/dynlink.ml
@@ -102,8 +102,10 @@ module Native = struct
       "_shared_startup" ::
       List.concat_map Unit_header.defined_symbols header.dynu_units
     in
-    ndl_register handle (Array.of_list syms);
-    handle, header.dynu_units
+    try
+      ndl_register handle (Array.of_list syms);
+      handle, header.dynu_units
+    with exn -> raise (DT.Error (Cannot_open_dynamic_library exn))
 
   let unsafe_get_global_value ~bytecode_or_asm_symbol =
     match ndl_loadsym bytecode_or_asm_symbol with
diff --git a/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference b/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference
index 37960f371f..0db2568b05 100644
--- a/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference
+++ b/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference
@@ -2,19 +2,24 @@ Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dyn
 Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29
 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15
 Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", line 86, characters 4-273
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 361, characters 11-54
 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 359, characters 8-392
-Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 374, characters 26-45
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 357, characters 6-372
+Called from Stdlib__Fun.protect in file "fun.ml" (inlined), line 33, characters 8-15
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 350, characters 4-662
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 369, characters 26-45
 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
 execution of module initializers in the shared library failed: Failure("SUCCESS")
 Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29
 Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 89, characters 10-149
 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15
 Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", line 86, characters 4-273
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 361, characters 11-54
 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 359, characters 8-392
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 372, characters 8-17
-Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 374, characters 26-45
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 357, characters 6-372
+Called from Stdlib__Fun.protect in file "fun.ml" (inlined), line 33, characters 8-15
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 350, characters 4-662
+Re-raised at Stdlib__Fun.protect in file "fun.ml" (inlined), line 38, characters 6-52
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 350, characters 4-662
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 369, characters 26-45
 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
diff --git a/testsuite/tests/backtrace/backtrace_dynlink.reference b/testsuite/tests/backtrace/backtrace_dynlink.reference
index 3f4fa74593..a0f23ec5b9 100644
--- a/testsuite/tests/backtrace/backtrace_dynlink.reference
+++ b/testsuite/tests/backtrace/backtrace_dynlink.reference
@@ -1,18 +1,18 @@
 Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38
 Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 361, characters 11-54
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 359, characters 8-392
-Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 374, characters 26-45
+Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 369, characters 26-45
 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
 execution of module initializers in the shared library failed: Failure("SUCCESS")
 Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29
 Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 89, characters 10-149
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 361, characters 11-54
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 359, characters 8-392
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 372, characters 8-17
-Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 374, characters 26-45
+Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15
+Re-raised at Stdlib__Fun.protect in file "fun.ml", line 38, characters 6-52
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 369, characters 26-45
 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
index d968c0b6ee..ea30752b30 100644
--- a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
@@ -5,8 +5,8 @@ Called from Test10_plugin.f in file "test10_plugin.ml", line 6, characters 2-6
 Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6
 Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 148, characters 16-25
 Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 150, characters 6-137
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 361, characters 11-54
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 359, characters 8-392
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 372, characters 8-17
+Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15
+Re-raised at Stdlib__Fun.protect in file "fun.ml", line 38, characters 6-52
 Called from Test10_main in file "test10_main.ml", line 51, characters 13-69
diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
index 89f1d20b39..ed720876b2 100755
--- a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
@@ -2,9 +2,9 @@ Error: Failure("Plugin error")
 Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 12-29
 Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 89, characters 10-149
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 363, characters 13-56
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 361, characters 11-54
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 359, characters 8-392
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 372, characters 8-17
-Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 374, characters 26-45
+Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15
+Re-raised at Stdlib__Fun.protect in file "fun.ml", line 38, characters 6-52
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 369, characters 26-45
 Called from Test10_main in file "test10_main.ml", line 49, characters 30-87