1		% (c) 2009-2022 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5
6		:- module(junit_tests,[junit_mode/1,unset_junit_dir/0,set_junit_dir/1,
7		unset_junit_test_suite_prefix/0, set_junit_test_suite_prefix/1, get_junit_test_suite_prefix/1,
8		full_junit_test_suite_name/2,
9		print_junit/2,create_junit_result/4,
10		create_and_print_junit_result/4]).
11
12		:- use_module(xml_prob,[xml_parse/2]).
13		:- use_module(library(lists)).
14		:- use_module(library(codesio)).
15		:- use_module(library(file_systems)).
16		:- use_module(library(system)).
17
18		:- use_module(module_information,[module_info/2]).
19		:- module_info(group,testing).
20		:- module_info(description,'This module provides functionality to output test case results in a format compatible to junit.').
21
22		:- set_prolog_flag(double_quotes, codes).
23
24
25		:- dynamic junit_mode/1.
26
27		unset_junit_dir :- retractall(junit_mode(_)).
28
29		set_junit_dir(Directory) :-
30		unset_junit_dir,
31		assertz(junit_mode(Directory)).
32
33		:- dynamic junit_test_suite_prefix/1.
34
35		unset_junit_test_suite_prefix :- retractall(junit_test_suite_prefix(_)).
36
37		set_junit_test_suite_prefix(Name) :-
38		unset_junit_test_suite_prefix,
39		assertz(junit_test_suite_prefix(Name)).
40
41		get_junit_test_suite_prefix(NameParts) :-
42		junit_test_suite_prefix(Name),
43		!,
44		(Name = '' -> NameParts = [] ; NameParts = [Name]).
45		get_junit_test_suite_prefix([Name]) :-
46		% Fallback if no test suite prefix was set
47		% to prevent parallel ProB processes from overwriting each other's test results.
48		get_process_id(PID),
49		ajoin(['pid', PID], Name).
50
51		full_junit_test_suite_name(SuffixParts, SuiteName) :-
52		get_junit_test_suite_prefix(PrefixParts),
53		append(PrefixParts, SuffixParts, SuiteNameParts),
54		ajoin_with_sep(SuiteNameParts, '.', SuiteName).
55
56		iso8601_datetime(ISODatime) :- datime(datime(Year,Month,Day,Hour,Min,Sec)),
57		format_to_codes('~`0t~d~2|-~`0t~d~3+-~`0t~d~3+T~`0t~d~3+:~`0t~d~3+:~`0t~d~3+',
58		[Year,Month,Day,Hour,Min,Sec], ISODatime).
59
60
61
62		% <testcase name="Call" classname="Selfcheck.Module" time="2"><error type="error"></testcase>
63
64		create_junit_result(Name, Time, Verdict, result(Name,TR,Verdict)) :-
65		junit_mode(_),!,
66		convert_to_junit_time(Time,TR).
67		create_junit_result(_Call, _Time, _Verdict, none).
68
69		convert_to_junit_time(T,R) :- number(T),!, R is T / 1000.
70
71		create_and_print_junit_result(SuiteNameSuffixParts, Name, Time, Verdict) :-
72		full_junit_test_suite_name(SuiteNameSuffixParts, SuiteName),
73		create_junit_result(Name, Time, Verdict,Result),
74		print_junit(SuiteName, [Result]).
75
76		print_junit(SuiteName, Results) :-
77		junit_mode(Dir),!,print_junit2(Dir,SuiteName,Results).
78		print_junit(_SuiteName, _Results).
79
80		:- use_module(tools_strings,[ajoin/2,ajoin_with_sep/3]).
81		:- use_module(tools_files,[put_codes/2]).
82		:- use_module(error_manager).
83		print_junit2(Dir,SuiteName,Results) :-
84	?	prepare_xml(SuiteName,Results,Codes),
85	?	open_file(0,Dir,SuiteName,Stream),
86		put_codes(Codes,Stream),
87		close(Stream),!.
88		print_junit2(Dir,SuiteName,_Results) :- add_error(junit_tests,'print_junit failed',Dir:SuiteName).
89
90		file_num_suffix(0, '').
91		file_num_suffix(N, Suffix) :-
92		N > 0,
93		ajoin(['.', N], Suffix).
94
95		:- use_module(tools_meta,[safe_on_exception/3]).
96		open_file(C,Dir,SuiteName,Stream) :-
97	?	file_num_suffix(C, CSuffix),
98		ajoin([Dir,'/',SuiteName,CSuffix,'.xml'], File),
99		open_file2(C,File,Dir,SuiteName,Stream).
100		open_file2(C,F,D,SN,Stream) :- file_exists(F),!, C1 is C+1, open_file(C1,D,SN,Stream).
101		open_file2(_C,File,_D,_SN,Stream) :-
102		safe_on_exception(E,open(File, write,Stream),
103		(print('### Exception while opening Junit File: '), print(File),nl,
104		add_error(junit_tests,'Junit File Opening Exception: ',File:E), fail)).
105
106		:- use_module(library(process),[process_id/1]).
107		get_process_id(PID) :- process_id(PID),!.
108		get_process_id(PID) :- print('### getting process_id failed'),nl,
109		% this shouldn't happen
110		PID='UNKNOWN'.
111
112		prepare_xml(SuiteName,Results,Codes) :-
113		atom_codes(SuiteName,SNCodes),
114		maplist(prepare_testcase_xml(SNCodes), Results,X),
115		% count tests
116		length(Results,TestsNr),
117		number_codes(TestsNr, Tests),
118		% count tests marked as error
119	?	count_results(error(_), Results, ErrorsNr),
120		number_codes(ErrorsNr, Errors),
121		% count skipped tests
122	?	count_results(skip, Results, SkippedNr),
123		number_codes(SkippedNr, Skipped),
124		% sum all test runtimes
125		maplist(extract_times, Results,Times),
126		sumlist(Times, TimeNr),
127		format_to_codes('~6f', [TimeNr], Time),
128		append([element(properties, [], [])|X],
129		[element('system-out',[], []), element('system-err', [], [])], Children),
130		iso8601_datetime(DT),
131		xml_parse(Codes,
132		xml([version="1.0",encoding="UTF-8"],
133		element(testsuite,
134		[name=SNCodes,hostname="Test Runner",tests=Tests,
135		skipped=Skipped,failures="0",
136		errors=Errors,time=Time,timestamp=DT],
137		Children))).
138		prepare_xml(SuiteName,Results,_Codes) :- add_error_fail(junit_tests,'prepare_xml failed',SuiteName:Results).
139
140		prepare_testcase_xml(_SNCodes,Result,_) :- var(Result),!,
141		add_error_fail(junit_tests,'prepare_testcase_xml called on non-ground result',Result).
142		prepare_testcase_xml(SNCodes,Result,element(testcase,R,Error)) :-
143		Result = result(Call,Time,Verdict),
144		R = [name=Name, classname=SNCodes, time=T],
145		write_to_codes(Call,Name),
146		( Verdict=pass -> Error=[]
147		; Verdict=error(E) -> (createError(E,Err), Error=[element(error,['='(type,"Error")],Err)])
148		; Verdict=skip -> Error=[element(skipped,[],[])]),
149		format_to_codes('~6f', [Time], T).
150
151		createError([],[]).
152		createError([E|T],[pcdata(Error)|R]) :- write_to_codes(E,Codes), append(["\n",Codes,"\n"],Error), createError(T,R).
153
154		extract_times(Result,_) :- var(Result),!,
155		add_error_fail(junit_tests,'extract_times called on non-ground result',Result).
156		extract_times(result(_,Time,_),Time).
157
158		count_results(_,Results,_) :- var(Results),!,
159		add_error_fail(junit_tests,'count_results called on non-ground list of results',Results).
160	?	count_results(Type,Results,Sum) :- count_results2(Type, Results, Sum).
161
162		count_results2(_, [], 0).
163	?	count_results2(Type,[result(_,_,Type)|Tail],Result) :- !, count_results2(Type,Tail,Temp), Result is 1 + Temp.
164	?	count_results2(Type,[result(_,_,_)|Tail],Result) :- !, count_results2(Type,Tail,Result).