Compare binary files block by block

ocamltest/filecompare.ml

@@ -56,9 +56,8 @@ type files = {
   output_filename : string;
 }
 
-let read_file bytes_to_ignore filetype fn =
+let read_text_file fn =
   let ic = open_in_bin fn in
-  seek_in ic bytes_to_ignore;
   let drop_cr s =
     let l = String.length s in
     if l > 0 && s.[l - 1] = '\r' then String.sub s 0 (l - 1)
@@ -69,15 +68,57 @@ let read_file bytes_to_ignore filetype fn =
     | s -> loop (s :: acc)
     | exception End_of_file ->
       close_in ic;
-      try
-        if filetype = Text then
-          List.rev_map drop_cr acc
-        else
-          raise Exit
+      try List.rev_map drop_cr acc
       with Exit -> List.rev acc
   in
   loop []
 
+let compare_text_files file1 file2 =
+  if read_text_file file1 = read_text_file file2 then
+    Same
+  else
+    Different
+
+(* Version of Pervasives.really_input which stops at EOF, rather than raising
+   an exception. *)
+let really_input_up_to ic =
+  let block_size = 8192 in
+  let buf = Bytes.create block_size in
+  let rec read pos =
+    let bytes_read = input ic buf pos (block_size - pos) in
+    let new_pos = pos + bytes_read in
+    if bytes_read = 0 || new_pos = block_size then
+      new_pos
+    else
+      read new_pos
+  in
+  let bytes_read = read 0 in
+  if bytes_read = block_size then
+    buf
+  else
+    Bytes.sub buf 0 bytes_read
+
+let compare_binary_files bytes_to_ignore file1 file2 =
+  let ic1 = open_in_bin file1 in
+  let ic2 = open_in_bin file2 in
+  seek_in ic1 bytes_to_ignore;
+  seek_in ic2 bytes_to_ignore;
+  let rec compare () =
+    let block1 = really_input_up_to ic1 in
+    let block2 = really_input_up_to ic2 in
+    if block1 = block2 then
+      if Bytes.length block1 > 0 then
+        compare ()
+      else
+        Same
+    else
+      Different
+  in
+  let result = compare () in
+  close_in ic1;
+  close_in ic2;
+  result
+
 let compare_files ?(tool = default_comparison_tool) files =
   match tool with
   | External {tool_name; tool_flags; result_of_exitcode} ->
@@ -96,11 +137,13 @@ let compare_files ?(tool = default_comparison_tool) files =
       let status = Run_command.run settings in
       result_of_exitcode commandline status
   | Internal bytes_to_ignore ->
-      let lines_of = read_file bytes_to_ignore files.filetype in
-      if lines_of files.reference_filename = lines_of files.output_filename then
-        Same
-      else
-        Different
+      match files.filetype with
+        | Text ->
+            (* bytes_to_ignore is silently ignored for text files *)
+            compare_text_files files.reference_filename files.output_filename
+        | Binary ->
+            compare_binary_files bytes_to_ignore
+                                 files.reference_filename files.output_filename
 
 let check_file ?(tool = default_comparison_tool) files =
   if Sys.file_exists files.reference_filename