diff options
| -rw-r--r-- | lib/system.ml | 8 | ||||
| -rw-r--r-- | lib/system.mli | 2 | ||||
| -rw-r--r-- | library/library.ml | 8 |
3 files changed, 10 insertions, 8 deletions
diff --git a/lib/system.ml b/lib/system.ml index ed23bde19..41201bd2d 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -113,9 +113,11 @@ let try_remove filename = (str"Could not remove file " ++ str filename ++ str" which is corrupted!") let marshal_out ch v = Marshal.to_channel ch v [] -let marshal_in ch = +let marshal_in filename ch = try Marshal.from_channel ch - with End_of_file -> error "corrupted file: reached end of file" + with + | End_of_file | Failure _ (* e.g. "truncated object" *) -> + error (filename ^ " is corrupted, try to rebuild it.") exception Bad_magic_number of string @@ -150,7 +152,7 @@ let extern_intern ?(warn=true) magic suffix = try let _,filename = find_file_in_path ~warn paths (CUnix.make_suffix name suffix) in let channel = raw_intern filename in - let v = marshal_in channel in + let v = marshal_in filename channel in close_in channel; v with Sys_error s -> diff --git a/lib/system.mli b/lib/system.mli index 0daf38b74..8cbbb9cab 100644 --- a/lib/system.mli +++ b/lib/system.mli @@ -32,7 +32,7 @@ val find_file_in_path : when the check fails, with the full file name. *) val marshal_out : out_channel -> 'a -> unit -val marshal_in : in_channel -> 'a +val marshal_in : string -> in_channel -> 'a exception Bad_magic_number of string diff --git a/library/library.ml b/library/library.ml index 681a79129..ea70f17c4 100644 --- a/library/library.ml +++ b/library/library.ml @@ -410,8 +410,8 @@ let fetch_opaque_table (f,pos,digest) = try let ch = System.with_magic_number_check raw_intern_library f in seek_in ch pos; - if not (String.equal (System.marshal_in ch) digest) then failwith "File changed!"; - let table = (System.marshal_in ch : LightenLibrary.table) in + if not (String.equal (System.marshal_in f ch) digest) then failwith "File changed!"; + let table = (System.marshal_in f ch : LightenLibrary.table) in close_in ch; table with _ -> @@ -421,9 +421,9 @@ let fetch_opaque_table (f,pos,digest) = let intern_from_file f = let ch = System.with_magic_number_check raw_intern_library f in - let lmd = System.marshal_in ch in + let lmd = System.marshal_in f ch in let pos = pos_in ch in - let digest = System.marshal_in ch in + let digest = System.marshal_in f ch in let table = lazy (fetch_opaque_table (f,pos,digest)) in register_library_filename lmd.md_name f; let library = mk_library lmd table digest in |