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
|
(****************************************************************************)
(* the diy toolsuite *)
(* *)
(* Jade Alglave, University College London, UK. *)
(* Luc Maranget, INRIA Paris-Rocquencourt, France. *)
(* *)
(* Copyright 2014-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. *)
(****************************************************************************)
(* Extract topology information from logs *)
open LogState
open Printf
module type Config = sig
val verbose : int
val shownames : bool
val ok : string -> bool
val hexa : bool
val int32 : bool
val faulttype : bool
end
module Make(O:Config) = struct
module LL =
LexLog_tools.Make
(struct
let verbose = O.verbose
let rename s = s
let ok = O.ok
let hexa = O.hexa
let int32 = O.int32
let acceptBig = false
let faulttype = O.faulttype
end)
module LS = LogState.Make(O)
let dump_test chan t =
if LS.some_topologies t.topologies then begin
if O.shownames then fprintf chan "Test %s%s\n" t.tname
(if is_reliable t.kind then " "^LS.pp_kind t.kind else "") ;
LS.dump_topologies chan t.topologies
end ;
()
let zyva ts chan =
Array.iter (dump_test chan) ts.tests
let of_chan name ichan ochan =
zyva (LL.read_chan name ichan) ochan
let of_name name chan =
zyva (LL.read_name name) chan
end
let names = ref []
let select = ref []
let verbose = ref 0
let shownames = ref true
let faulttype = ref true
let log = ref None
let options =
let open CheckName in
[
("-v", Arg.Unit (fun _ -> incr verbose),
"<non-default> show various diagnostics, repeat to increase verbosity");
("-shownames", Arg.Bool (fun b -> shownames := b),
(sprintf "<bool> show test names in output, default %b" !shownames));
parse_select select; parse_names names;
parse_faulttype faulttype;
]
let prog =
if Array.length Sys.argv > 0 then Sys.argv.(0)
else "mtopos"
let parse_log s = match !log with
| None -> log := Some s
| Some _ -> raise (Arg.Bad "at most one argument")
let () =
Arg.parse options
parse_log
(sprintf "Usage %s [options]* [log]
- log is a litmus log
- options are:" prog)
module Check =
CheckName.Make
(struct
let verbose = !verbose
let rename = []
let select = !select
let names = !names
let excl = []
end)
module Config = struct
let verbose = !verbose
let shownames = !shownames
let ok = Check.ok
let hexa = false
let int32 = true
let faulttype = !faulttype
end
module X = Make(Config)
let () = match !log with
| None -> X.of_chan "*stdin*" stdin stdout
| Some log -> X.of_name log stdout
|
