Imported Upstream version 8.5~beta3+dfsg

1 files changed, 17 insertions, 11 deletions

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 605c1225..b2142b43 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -94,7 +94,10 @@ let compile_library dir code fn =
   let basename = Filename.basename fn in
   let dirname = Filename.dirname fn in
   let dirname = dirname / output_dir in
-  if not (Sys.file_exists dirname) then Unix.mkdir dirname 0o755;
+  let () =
+    try Unix.mkdir dirname 0o755
+    with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
+  in
   let fn = dirname / basename in
   write_ml_code fn ~header code;
   let r = fst (call_compiler fn) in
@@ -102,22 +105,25 @@ let compile_library dir code fn =
   r
 
 (* call_linker links dynamically the code for constants in environment or a  *)
-(* conversion test. Silently fails if the file does not exist in bytecode    *)
-(* mode, since the standard library is not compiled to bytecode with default *)
-(* settings.                                                                 *)
+(* conversion test. *)
 let call_linker ?(fatal=true) prefix f upds =
   rt1 := dummy_value ();
   rt2 := dummy_value ();
-  if Dynlink.is_native || Sys.file_exists f then
+  if not (Sys.file_exists f) then
+    begin
+      let msg = "Cannot find native compiler file " ^ f in
+      if fatal then Errors.error msg
+      else if !Flags.debug then Pp.msg_debug (Pp.str msg)
+    end
+  else
   (try
     if Dynlink.is_native then Dynlink.loadfile f else !load_obj f;
     register_native_file prefix
-   with | Dynlink.Error e ->
-          let msg = "Dynlink error, " ^ Dynlink.error_message e in
-          if fatal then anomaly (Pp.str msg) else Pp.msg_warning (Pp.str msg)
-        | e when Errors.noncritical e ->
-          if fatal then anomaly (Errors.print e)
-	  else Pp.msg_warning (Errors.print_no_report e));
+   with Dynlink.Error e as exn ->
+     let exn = Errors.push exn in
+     let msg = "Dynlink error, " ^ Dynlink.error_message e in
+     if fatal then (Pp.msg_error (Pp.str msg); iraise exn)
+     else if !Flags.debug then Pp.msg_debug (Pp.str msg));
   match upds with Some upds -> update_locations upds | _ -> ()
 
 let link_library ~prefix ~dirname ~basename =