4 files changed, 42 insertions, 38 deletions

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