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
|
(****************************************************************************)
(* the diy toolsuite *)
(* *)
(* Jade Alglave, University College London, UK. *)
(* Luc Maranget, INRIA Paris-Rocquencourt, France. *)
(* *)
(* Copyright 2012-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. *)
(****************************************************************************)
(****************)
(* Command line *)
(****************)
let parse_select select =
"-select",
Arg.String (fun s -> select := !select @ [s]),
"<name> specify test or test index file, can be repeated"
let parse_names names =
"-names",
Arg.String (fun s -> names := !names @ [s]),
"<name> specify file of names, can be repeated"
let parse_rename rename =
"-rename", Arg.String (fun s -> rename := !rename @ [s]),
"<name> specify a rename mapping, hashes are checked"
let parse_excl excl =
"-excl", Arg.String (fun s -> excl := !excl @ [s]),
"<name> specify file of names to be excluded, can be repeated"
let parse_hexa hexa =
"-hexa", Arg.Bool (fun b -> hexa := b),
(Printf.sprintf "<bool> specify hexadecimal output, default %b" !hexa)
let parse_int32 int32 =
"-int32", Arg.Bool (fun b -> int32 := b),
(Printf.sprintf "<bool> integer in logs are 32 bits wide, default %b" !int32)
let parse_faulttype ft =
("-faulttype", Arg.Bool (fun b -> ft := b),
Printf.sprintf
"<bool> consider fault types, default %b" !ft);
module
Make
(I:sig
val verbose : int
val rename : string list
val select : string list
val names : string list
val excl : string list
end) =
struct
(******************)
(* Rename mapping *)
(******************)
module LR = LexRename.Make(I)
let rename_table = LR.read_from_files I.rename (fun s -> Some s)
let rename name =
try TblRename.find_value rename_table name
with Not_found -> name
let rename_opt name = TblRename.find_value_opt rename_table name
(******************)
(* Name selection *)
(******************)
let names1 = match I.select with
| [] -> None
| args ->
let names = Names.from_fnames (Misc.expand_argv args) in
let names = List.rev_map rename names in
let set = StringSet.of_list names in
Some set
let names2 = match I.names with
| [] -> None
| args ->
let names =
List.fold_left
(fun r name -> ReadNames.from_file (rename name) Misc.cons r)
[] args in
let set = StringSet.of_list names in
Some set
let names_excl = match I.excl with
| [] -> None
| args ->
let names =
List.fold_left
(fun r name -> ReadNames.from_file (rename name) Misc.cons r)
[] args in
let set = StringSet.of_list names in
if I.verbose > 0 then
Printf.eprintf "Excl {%s}\n" (StringSet.pp_str "," (fun s -> s) set) ;
Some set
let names3 = match names1,names2 with
| (None,ns)|(ns,None) -> ns
| Some ns1,Some ns2 -> Some (StringSet.union ns1 ns2)
let names = match names3 with
| None -> None
| Some ns -> match names_excl with
| None -> names3
| Some e -> Some (StringSet.diff ns e)
let ok = match names with
| None ->
begin match names_excl with
| None ->fun _ -> true
| Some e ->
if I.verbose > 0 then
fun n ->
let b = not (StringSet.mem n e) in
Printf.eprintf "Check %s -> %b\n" n b ;
b
else fun n -> not (StringSet.mem n e)
end
| Some ns -> fun n -> StringSet.mem n ns
end
|
