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
|
(****************************************************************************)
(* 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. *)
(****************************************************************************)
(* Select tests according to various criteria
-threads <n> maximal number of threads
-ins <n> maximal number of instruction on a thread
*)
open Printf
module Top
(Opt:
sig
val verbose : int
val ins : Interval.t
val threads : Interval.t
val arch_ok : Archs.t -> bool
val name_ok : string -> bool
end) =
struct
module T = struct
type t = bool
end
module Make(A:ArchBase.S)(Pte:PteVal.S) = struct
let zyva name parsed =
let prog = parsed.MiscParser.prog in
Opt.arch_ok A.arch && Opt.name_ok name.Name.name &&
Interval.inside Opt.threads (List.length prog) &&
List.for_all
(fun (_,code) -> Interval.inside Opt.ins (List.length code))
prog
end
module Z = ToolParse.Top(T)(Make)
let do_test name =
try
let ok = Z.from_file name in
if ok then begin
if Opt.verbose >= 0 then Printf.printf "%s\n" name
end ;
if Opt.verbose < 0 then exit (if ok then 0 else 1)
with
| Misc.Exit -> ()
| Misc.Fatal msg|Misc.UserError msg ->
Warn.warn_always "%a %s" Pos.pp_pos0 name msg
| e ->
Printf.eprintf "\nFatal: %a Adios\n" Pos.pp_pos0 name ;
raise e
let zyva = Misc.iter_argv_or_stdin do_test
end
(* Go *)
let parse_inter s =
try
LexInterval.parse s
with LexInterval.Error ->
raise (Arg.Bad (sprintf "'%s' is not an interval specification" s))
let set_inter x s = x := parse_inter s
let ins = ref Interval.all
let threads = ref Interval.all
let verbose = ref 0
let tests = ref []
let archs = ref []
let names = ref []
and excl = ref []
and rename = ref []
let prog =
if Array.length Sys.argv > 0 then Sys.argv.(0)
else "mselect"
let () =
Arg.parse
["-v",Arg.Unit (fun () -> incr verbose), " be verbose";
"-q",Arg.Unit (fun () -> verbose := -1), " quiet mode, status only";
begin let module P = ParseTag.Make(Archs) in
P.parse_fun
"-arch" (fun a -> archs := !archs @ [a]) "select architecture, can be repeated" end ;
CheckName.parse_names names ;
CheckName.parse_excl excl ;
CheckName.parse_rename rename ;
"-ins", Arg.String (set_inter ins),
sprintf "<inter> instruction count, default %s" (Interval.pp !ins);
"-threads", Arg.String (set_inter threads),
sprintf "<inter> thread count, default %s" (Interval.pp !threads);]
(fun s -> tests := s :: !tests)
(sprintf "Usage: %s [options]* [test]*" prog)
module Check =
CheckName.Make
(struct
let verbose = !verbose
let rename = []
let select = []
let names = !names
let excl = !excl
end)
module X = Top
(struct
let verbose = !verbose
let ins = !ins
let threads = !threads
let arch_ok = match !archs with
| [] -> fun _ -> true
| archs ->
let module S = MySet.Make(Archs) in
let archs = S.of_list archs in
fun a -> S.mem a archs
let name_ok = Check.ok
end)
let () = X.zyva !tests
|
