v8.4: Granting bug/wish #2976 (turning anomaly on input_value into nice message)

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16183 85f007b7-540e-0410-9357-904b9bb8a0f7

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