Compare binary files block by block
parent
b1058dd4f8
commit
ffb5db9342
|
@ -56,9 +56,8 @@ type files = {
|
||||||
output_filename : string;
|
output_filename : string;
|
||||||
}
|
}
|
||||||
|
|
||||||
let read_file bytes_to_ignore filetype fn =
|
let read_text_file fn =
|
||||||
let ic = open_in_bin fn in
|
let ic = open_in_bin fn in
|
||||||
seek_in ic bytes_to_ignore;
|
|
||||||
let drop_cr s =
|
let drop_cr s =
|
||||||
let l = String.length s in
|
let l = String.length s in
|
||||||
if l > 0 && s.[l - 1] = '\r' then String.sub s 0 (l - 1)
|
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)
|
| s -> loop (s :: acc)
|
||||||
| exception End_of_file ->
|
| exception End_of_file ->
|
||||||
close_in ic;
|
close_in ic;
|
||||||
try
|
try List.rev_map drop_cr acc
|
||||||
if filetype = Text then
|
|
||||||
List.rev_map drop_cr acc
|
|
||||||
else
|
|
||||||
raise Exit
|
|
||||||
with Exit -> List.rev acc
|
with Exit -> List.rev acc
|
||||||
in
|
in
|
||||||
loop []
|
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 =
|
let compare_files ?(tool = default_comparison_tool) files =
|
||||||
match tool with
|
match tool with
|
||||||
| External {tool_name; tool_flags; result_of_exitcode} ->
|
| 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
|
let status = Run_command.run settings in
|
||||||
result_of_exitcode commandline status
|
result_of_exitcode commandline status
|
||||||
| Internal bytes_to_ignore ->
|
| Internal bytes_to_ignore ->
|
||||||
let lines_of = read_file bytes_to_ignore files.filetype in
|
match files.filetype with
|
||||||
if lines_of files.reference_filename = lines_of files.output_filename then
|
| Text ->
|
||||||
Same
|
(* bytes_to_ignore is silently ignored for text files *)
|
||||||
else
|
compare_text_files files.reference_filename files.output_filename
|
||||||
Different
|
| Binary ->
|
||||||
|
compare_binary_files bytes_to_ignore
|
||||||
|
files.reference_filename files.output_filename
|
||||||
|
|
||||||
let check_file ?(tool = default_comparison_tool) files =
|
let check_file ?(tool = default_comparison_tool) files =
|
||||||
if Sys.file_exists files.reference_filename
|
if Sys.file_exists files.reference_filename
|
||||||
|
|
Loading…
Reference in New Issue