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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
#!/usr/bin/ocamlrun ocaml
(* Copyright (C) 2010-2014 Red Hat Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License along
* with this program; if not, write to the Free Software Foundation, Inc.,
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
open Printf
#load "str.cma"
#load "unix.cma"
type test_result =
| Pass
| Skip
| XFail
| Fail
| XPass
| Error
let (//) = Filename.concat
let read_whole_file path =
let buf = Buffer.create 16384 in
let chan = open_in path in
let maxlen = 16384 in
let s = String.create maxlen in
let rec loop () =
let r = input chan s 0 maxlen in
if r > 0 then (
Buffer.add_subbytes buf s 0 r;
loop ()
)
in
loop ();
close_in chan;
Buffer.contents buf
let string_charsplit sep =
Str.split (Str.regexp_string sep)
let rec string_find s sub =
let len = String.length s in
let sublen = String.length sub in
let rec loop i =
if i <= len-sublen then (
let rec loop2 j =
if j < sublen then (
if s.[i+j] = sub.[j] then loop2 (j+1)
else -1
) else
i (* found *)
in
let r = loop2 0 in
if r = -1 then loop (i+1) else r
) else
-1 (* not found *)
in
loop 0
let rec string_replace s s1 s2 =
let len = String.length s in
let sublen = String.length s1 in
let i = string_find s s1 in
if i = -1 then s
else (
let s' = String.sub s 0 i in
let s'' = String.sub s (i+sublen) (len-i-sublen) in
s' ^ s2 ^ string_replace s'' s1 s2
)
let find_trs basedir =
let split_dirs_and_files items =
let rec work dirs files = function
| [] -> dirs, files
| ((_, full_x) as x) :: xs ->
match (Unix.LargeFile.lstat full_x).Unix.LargeFile.st_kind with
| Unix.S_REG -> work dirs (x :: files) xs
| Unix.S_DIR -> work (x :: dirs) files xs
| _ -> work dirs files xs
in
work [] [] items
in
let rec internal_find_trs basedir stack =
let items = Array.to_list (Sys.readdir basedir) in
let items = List.map (fun x -> x, basedir // x) items in
let dirs, files = split_dirs_and_files items in
let files = List.filter (fun (x, _) -> Filename.check_suffix x ".trs") files in
let files = List.map (fun (_, full_x) -> stack, full_x) files in
let subdirs_files = List.fold_left (
fun acc (fn, dir) ->
(internal_find_trs dir (fn :: stack)) :: acc
) [] dirs in
let subdirs_files = List.rev subdirs_files in
List.concat (files :: subdirs_files)
in
internal_find_trs basedir ["tests"]
let sanitize_log log =
let log = string_replace log "\x1b[0;32m" "" in
let log = string_replace log "\x1b[1;31m" "" in
let log = string_replace log "\x1b[1;34m" "" in
let log = string_replace log "\x1b[1;35m" "" in
let log = string_replace log "\x1b[0m" "" in
let log = string_replace log "\x0d" "" in
log
let escape_text text =
let text = string_replace text "&" "&" in
let text = string_replace text "\"" """ in
let text = string_replace text "<" "<" in
text
let iterate_results trs_files =
let total = ref 0 in
let failures = ref 0 in
let errors = ref 0 in
let skipped = ref 0 in
let total_time = ref 0 in
let buf = Buffer.create 16384 in
let read_trs file =
let log_filename = (Filename.chop_suffix file ".trs") ^ ".log" in
let content = read_whole_file file in
let lines = string_charsplit "\n" content in
let testname = ref (Filename.chop_suffix (Filename.basename file) ".trs") in
let res = ref Pass in
let time = ref 0 in
List.iter (
fun line ->
let line = string_charsplit " " line in
(match line with
| ":test-result:" :: result :: rest ->
let name = String.concat " " rest in
if String.length name > 0 then testname := name;
res :=
(match result with
| "PASS" -> Pass
| "SKIP" -> Skip
| "XFAIL" -> XFail
| "FAIL" -> Fail
| "XPASS" -> XPass
| "ERROR" | _ -> Error);
| ":guestfs-time:" :: delta :: _ ->
time := int_of_string delta
| _ -> ()
);
) lines;
!testname, !res, !time, log_filename in
List.iter (
fun (stack, file) ->
let testname, result, time, log_filename = read_trs file in
let log = try read_whole_file log_filename with _ -> "" in
let log = sanitize_log log in
let print_tag_with_log tag =
Buffer.add_string buf (sprintf " <testcase name=\"%s\" classname=\"%s\" time=\"%d\">\n" testname (String.concat "." (List.rev stack)) time);
Buffer.add_string buf (sprintf " <%s><![CDATA[%s]]></%s>\n" tag log tag);
Buffer.add_string buf (sprintf " </testcase>\n")
in
(match result with
| Pass ->
print_tag_with_log "system-out"
| Skip ->
skipped := !skipped + 1;
Buffer.add_string buf (sprintf " <testcase name=\"%s\" classname=\"%s\" time=\"%d\">\n" testname (String.concat "." (List.rev stack)) time);
Buffer.add_string buf (sprintf " <skipped message=\"%s\"></skipped>\n" (escape_text log));
Buffer.add_string buf (sprintf " </testcase>\n")
| XFail | Fail | XPass ->
failures := !failures + 1;
print_tag_with_log "error"
| Error ->
errors := !errors + 1;
print_tag_with_log "error"
);
total := !total + 1;
total_time := !total_time + time
) trs_files;
Buffer.contents buf, !total, !failures, !errors, !skipped, !total_time
let sort_trs (_, f1) (_, f2) =
compare f1 f2
let () =
if Array.length Sys.argv < 3 then (
printf "%s PROJECTNAME BASEDIR\n" Sys.argv.(0);
exit 1
);
let name = Sys.argv.(1) in
let basedir = Sys.argv.(2) in
let trs_files = List.sort sort_trs (find_trs basedir) in
let buf, total, failures, errors, skipped, time =
iterate_results trs_files in
printf "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<testsuite name=\"%s\" tests=\"%d\" failures=\"%d\" skipped=\"%d\" errors=\"%d\" time=\"%d\">
<properties />
%s</testsuite>
" name total failures skipped errors time buf
|
