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
let patch ~(suffix : string) (filenames : string list)
(filenames_patch : string list) : string list =
List.map
(fun filename ->
let filename_base = Filesys.base ~suffix filename in
let filename_patch_opt =
List.find_opt
(fun filename_patch ->
let filename_patch_base = Filesys.base ~suffix filename_patch in
String.equal filename_base filename_patch_base)
filenames_patch
in
match filename_patch_opt with
| Some filename_patch -> filename_patch
| None -> filename)
filenames
let patch_with_basedir ~(suffix : string) (filenames : (string * string) list)
(filenames_patch : (string * string) list) : (string * string * bool) list =
List.map
(fun (basedir, filename) ->
let filename_base = Filesys.base ~suffix filename in
let filename_patch_opt =
List.find_opt
(fun (_, filename_patch) ->
let filename_patch_base = Filesys.base ~suffix filename_patch in
String.equal filename_base filename_patch_base)
filenames_patch
in
match filename_patch_opt with
| Some (basedir_patch, filename_patch) ->
(basedir_patch, filename_patch, true)
| None -> (basedir, filename, false))
filenames
let collect_exclude filename_exclude =
let ic = open_in filename_exclude in
let rec parse_lines excludes =
try
let exclude = input_line ic in
if String.starts_with ~prefix:"#" exclude then parse_lines excludes
else parse_lines (exclude :: excludes)
with End_of_file -> excludes
in
let excludes = parse_lines [] in
close_in ic;
excludes
let collect_excludes (paths_exclude : string list) =
let filenames_exclude =
List.concat_map (Filesys.collect_files ~suffix:".exclude") paths_exclude
in
List.concat_map collect_exclude filenames_exclude
let collect_excludes_by_subdir (paths_exclude : string list) :
(string * string list) list =
List.concat_map
(fun path_exclude ->
let parent_name = Filename.basename path_exclude in
let subdirs =
Sys_unix.readdir path_exclude
|> Array.to_list
|> List.filter (fun f ->
Sys_unix.is_directory_exn (path_exclude ^ "/" ^ f))
|> List.sort String.compare
in
List.map
(fun subdir ->
let subdir_path = path_exclude ^ "/" ^ subdir in
let filenames_exclude =
Filesys.collect_files ~suffix:".exclude" subdir_path
in
let entries = List.concat_map collect_exclude filenames_exclude in
(parent_name ^ "/" ^ subdir, entries))
subdirs)
paths_exclude
let should_exclude_pair (filename_p4 : string) (filename_stf : string)
(excludes : string list) =
excludes
|> List.exists (fun exclude ->
String.equal filename_p4 exclude || String.equal filename_stf exclude)
let p4_matches_stf filepath_p4 filepath_stf =
let dir_p4 = Filename.dirname filepath_p4 in
let base_p4 = Filesys.base ~suffix:".p4" filepath_p4 in
let dir_stf = Filename.dirname filepath_stf in
let base_stf = Filesys.base ~suffix:".stf" filepath_stf in
base_p4 = dir_stf || (dir_p4 = dir_stf && base_p4 = base_stf)
let collect_test_pairs (arch : string) (testdirs_p4 : string list)
(testdirs_stf : string list) (patchdirs : string list) :
(string * string * bool) list =
let filenames_p4 =
List.concat_map
(Filesys.collect_files_with_basedir ~suffix:".p4")
testdirs_p4
in
let filenames_p4 =
List.filter
(fun (dir, filename) ->
let contents = Filesys.read_file (dir ^ "/" ^ filename) in
match arch with
| "v1model" ->
Strings.contains_substring "#include <v1model.p4>" contents
|| Strings.contains_substring "#include \"v1model.p4\"" contents
| "ebpf" ->
Strings.contains_substring "#include <ebpf_model.p4>" contents
|| Strings.contains_substring "#include \"ebpf_model.p4\"" contents
| "psa" ->
Strings.contains_substring "#include <bmv2/psa.p4>" contents
|| Strings.contains_substring "#include \"bmv2/psa.p4\"" contents
| _ -> false)
filenames_p4
in
let filenames_p4_patch =
patchdirs
|> List.concat_map (Filesys.collect_files_with_basedir ~suffix:".p4")
in
let filenames_p4 =
patch_with_basedir ~suffix:".p4" filenames_p4 filenames_p4_patch
in
let filenames_stf =
List.concat_map
(Filesys.collect_files_with_basedir ~suffix:".stf")
testdirs_stf
in
let filenames_stf_patch =
patchdirs
|> List.concat_map (Filesys.collect_files_with_basedir ~suffix:".stf")
in
let filenames_stf =
patch_with_basedir ~suffix:".stf" filenames_stf filenames_stf_patch
in
filenames_p4
|> List.filter_map (fun (basedir_p4, filename_p4, is_p4_patched) ->
let matched_stfs =
List.filter_map
(fun (basedir_stf, filename_stf, is_stf_patched) ->
if p4_matches_stf filename_p4 filename_stf then
Some (basedir_stf ^ "/" ^ filename_stf, is_stf_patched)
else None)
filenames_stf
in
match matched_stfs with
| [] -> None
| _ ->
Some (basedir_p4 ^ "/" ^ filename_p4, is_p4_patched, matched_stfs))
|> List.concat_map (fun (filename_p4, is_p4_patched, matched_stfs) ->
List.map
(fun (filename_stf, is_stf_patched) ->
(filename_p4, filename_stf, is_p4_patched || is_stf_patched))
matched_stfs)