#5411: close input channel when loading a .cmo file fails in the toplevel.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@11315 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 37 insertions, 28 deletions

diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index d696c363f..57d1f1e11 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -86,31 +86,43 @@ let load_compunit ic filename ppf compunit =
   end
 
 let rec load_file recursive ppf name =
+  let filename = try Some (find_in_path !Config.load_path name) with Not_found -> None in
+  match filename with
+  | None -> fprintf ppf "Cannot find file %s.@." name; false
+  | Some filename ->
+      let ic = open_in_bin filename in
+      try
+        let success = really_load_file recursive ppf name filename ic in
+        close_in ic;
+        success
+      with exn ->
+        close_in ic;
+        raise exn
+
+and really_load_file recursive ppf name filename ic =
+  let ic = open_in_bin filename in
+  let buffer = String.create (String.length Config.cmo_magic_number) in
+  really_input ic buffer 0 (String.length Config.cmo_magic_number);
   try
-    let filename = find_in_path !Config.load_path name in
-    let ic = open_in_bin filename in
-    let buffer = String.create (String.length Config.cmo_magic_number) in
-    really_input ic buffer 0 (String.length Config.cmo_magic_number);
-    let success = try
-      if buffer = Config.cmo_magic_number then begin
-        let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
-        seek_in ic compunit_pos;
-        let cu : compilation_unit = input_value ic in
-        if recursive then
-          List.iter
-            (function
-              | (Reloc_getglobal id, _) when not (Symtable.is_global_defined id) ->
-                  let file = Ident.name id ^ ".cmo" in
-                  begin match try Some (Misc.find_in_path_uncap !Config.load_path file) with Not_found -> None with
-                  | None -> ()
-                  | Some file -> if not (load_file recursive ppf file) then raise Load_failed
-                  end
-              | _ -> ()
-            )
-            cu.cu_reloc;
-        load_compunit ic filename ppf cu;
-        true
-      end else
+    if buffer = Config.cmo_magic_number then begin
+      let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
+      seek_in ic compunit_pos;
+      let cu : compilation_unit = input_value ic in
+      if recursive then
+        List.iter
+          (function
+            | (Reloc_getglobal id, _) when not (Symtable.is_global_defined id) ->
+                let file = Ident.name id ^ ".cmo" in
+                begin match try Some (Misc.find_in_path_uncap !Config.load_path file) with Not_found -> None with
+                | None -> ()
+                | Some file -> if not (load_file recursive ppf file) then raise Load_failed
+                end
+            | _ -> ()
+          )
+          cu.cu_reloc;
+      load_compunit ic filename ppf cu;
+      true
+    end else
       if buffer = Config.cma_magic_number then begin
         let toc_pos = input_binary_int ic in  (* Go to table of contents *)
         seek_in ic toc_pos;
@@ -131,10 +143,7 @@ let rec load_file recursive ppf name =
         fprintf ppf "File %s is not a bytecode object file.@." name;
         false
       end
-    with Load_failed -> false in
-    close_in ic;
-    success
-  with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
+  with Load_failed -> false
 
 let dir_load ppf name = ignore (load_file false ppf name)