#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
master
Alain Frisch 2011-12-14 11:04:06 +00:00
parent 0b002c286a
commit 032648c3d4
1 changed files with 37 additions and 28 deletions

View File

@ -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)