blob: 9e88d31e934782c0b984c8c7ab950b41cdf14be6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* File comparison tools *)
open Ocamltest_stdlib
type result =
| Same
| Different
| Unexpected_output
| Error of string * int
type ignore = {bytes: int; lines: int}
type tool =
| External of {
tool_name : string;
tool_flags : string;
result_of_exitcode : string -> int -> result
}
| Internal of ignore
let cmp_result_of_exitcode commandline = function
| 0 -> Same
| 1 -> Different
| exit_code -> (Error (commandline, exit_code))
let make_cmp_tool ~ignore =
Internal ignore
let make_comparison_tool ?(result_of_exitcode = cmp_result_of_exitcode)
name flags =
External
{
tool_name = name;
tool_flags = flags;
result_of_exitcode
}
let default_comparison_tool = make_cmp_tool ~ignore:{bytes=0;lines=0}
type filetype = Binary | Text
type files = {
filetype : filetype;
reference_filename : string;
output_filename : string;
}
let read_text_file lines_to_drop fn =
let ic = open_in_bin fn in
let drop_cr s =
let l = String.length s in
if l > 0 && s.[l - 1] = '\r' then String.sub s 0 (l - 1)
else raise Exit
in
let rec drop k =
if k = 0 then
loop []
else
let stop = try ignore (input_line ic); false with End_of_file -> true in
if stop then [] else drop (k-1)
and loop acc =
match input_line ic with
| s -> loop (s :: acc)
| exception End_of_file ->
close_in ic;
try List.rev_map drop_cr acc
with Exit -> List.rev acc
in
drop lines_to_drop
let compare_text_files dropped_lines file1 file2 =
if read_text_file 0 file1 = read_text_file dropped_lines 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} ->
let commandline = String.concat " "
[
tool_name;
tool_flags;
files.reference_filename;
files.output_filename
] in
let dev_null = match Sys.os_type with
| "Win32" -> "NUL"
| _ -> "/dev/null" in
let settings = Run_command.settings_of_commandline
~stdout_fname:dev_null ~stderr_fname:dev_null commandline in
let status = Run_command.run settings in
result_of_exitcode commandline status
| Internal ignore ->
match files.filetype with
| Text ->
(* bytes_to_ignore is silently ignored for text files *)
compare_text_files ignore.lines
files.reference_filename files.output_filename
| Binary ->
compare_binary_files ignore.bytes
files.reference_filename files.output_filename
let check_file ?(tool = default_comparison_tool) files =
if Sys.file_exists files.reference_filename
then compare_files ~tool:tool files
else begin
if Sys.file_is_empty files.output_filename
then Same
else Unexpected_output
end
let diff files =
let temporary_file = Filename.temp_file "ocamltest" "diff" in
let diff_commandline = String.concat " "
[
"diff -u";
files.reference_filename;
files.output_filename;
"> " ^ temporary_file
] in
if (Sys.command diff_commandline) = 2 then Pervasives.Error "diff"
else Ok (Sys.string_of_file temporary_file)
|
