Compare binary files block by block
parent
b1058dd4f8
commit
ffb5db9342
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue