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
|
(****************************************************************************)
(* the diy toolsuite *)
(* *)
(* Jade Alglave, University College London, UK. *)
(* Luc Maranget, INRIA Paris-Rocquencourt, France. *)
(* *)
(* Copyright 2015-present Institut National de Recherche en Informatique et *)
(* en Automatique and the authors. All rights reserved. *)
(* *)
(* This software is governed by the CeCILL-B license under French law and *)
(* abiding by the rules of distribution of free software. You can use, *)
(* modify and/ or redistribute the software under the terms of the CeCILL-B *)
(* license as circulated by CEA, CNRS and INRIA at the following URL *)
(* "http://www.cecill.info". We also give a copy in LICENSE.txt. *)
(****************************************************************************)
open Printf
let prog =
if Array.length Sys.argv > 0 then Sys.argv.(0)
else "mcmp"
(* Simple outcome comparator, memory efficient *)
module type Opt = sig
val verbose : int
val quiet : bool
val same : bool
val ok : string -> bool
val pos : string option
val neg : string option
val faulttype : bool
end
module Make(O:Opt) = struct
module LL =
LexLog_tools.Make
(struct
let verbose = O.verbose
let rename n = n
let ok = O.ok
let hexa = false
let int32 = true
let acceptBig = true
let faulttype = O.faulttype
end)
module LS = LogState.Make(O)
let read_logs fnames = LL.read_names_simple fnames
let cmp_logs fname t1 t2 = match fname with
| Some fname ->
Misc.output_protect
(fun chan ->
LS.simple_diff_not_empty
(fun n _ -> fprintf chan "%s\n" n ; true)
t1 t2 false) fname
| None -> false
let simple_diff pp t1 t2 =
LS.simple_diff
(fun n _ -> pp n ; true)
t1 t2 false
let simple_same pp1 pp2 t1 t2 =
LS.simple_same
(fun n _ -> pp1 n ; true)
(fun n _ -> pp2 n ; true)
t1 t2 false
let run f1 f2 =
match read_logs [f1;f2;] with
| [t1;t2] ->
if O.same then
simple_same
(if O.quiet then (fun _ -> ()) else printf "%s: %s\n%!" f1)
(if O.quiet then (fun _ -> ()) else printf "%s: %s\n%!" f2)
t1 t2
else
let b0 =
simple_diff
(if O.quiet then (fun _ -> ()) else printf "%s\n") t1 t2 in
let b1 = cmp_logs O.pos t1 t2 in
let b2 = cmp_logs O.neg t2 t1 in
b0 || b1 || b2
| _ ->
Warn.user_error "%s operates on two log files" prog
end
let verbose = ref 0
let select = ref []
let names = ref []
let excl = ref []
let pos = ref None
let neg = ref None
let quiet = ref false
let same = ref false
let faulttype = ref true
let options =
[
("-v", Arg.Unit (fun _ -> incr verbose),
"<non-default> show various diagnostics, repeat to increase verbosity") ;
("-q", Arg.Unit (fun _ -> quiet := true; verbose := 0;),
"<non-default> be quite, no output at all") ;
("-same", Arg.Unit (fun _ -> same := true),
"<non-default> check that logs contain the same tests") ;
("-pos",
Arg.String (fun s -> pos := Some s),
" <file> dump positive differences, default "^ (match !pos with None -> "don't dump" | Some s -> s));
("-neg",
Arg.String (fun s -> neg := Some s),
"<file> dump negative differences, default "^ (match !neg with None -> "don't dump" | Some s -> s));
CheckName.parse_select select;
CheckName.parse_names names;
CheckName.parse_excl excl;
CheckName.parse_faulttype faulttype;
]
let logs = ref []
let () =
Arg.parse options
(fun s -> logs := s :: !logs)
(sprintf "Usage %s [options]* log1 log2
- logs are log file names from memevents or litmus
- options are:" prog)
module Check =
CheckName.Make
(struct
let verbose = !verbose
let rename = []
let select = !select
let names = !names
let excl = !excl
end)
module M =
Make
(struct
let verbose = !verbose
let quiet = !quiet
let same = !same
let ok = Check.ok
let pos = !pos
let neg = !neg
let faulttype = !faulttype
end)
let f1,f2 = match !logs with
| [f1;f2;] -> f1,f2
| _ ->
eprintf "%s takes two arguemts\n" prog ; exit 2
let () =
let some_diff = M.run f1 f2 in
if some_diff then
exit 1
else
exit 0
|
