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		print_junit/2,create_junit_result/4,
8		create_and_print_junit_result/4]).
9
10		:- use_module(xml_prob,[xml_parse/2]).
11		:- use_module(library(lists)).
12		:- use_module(library(codesio)).
13		:- use_module(library(file_systems)).
14		:- use_module(library(system)).
15
16		:- use_module(module_information,[module_info/2]).
17		:- module_info(group,testing).
18		:- module_info(description,'This module provides functionality to output test case results in a format compatible to junit.').
19
20		:- set_prolog_flag(double_quotes, codes).
21
22
23		:- dynamic junit_mode/1.
24
25		unset_junit_dir :- retractall(junit_mode(_)).
26
27		set_junit_dir(Directory) :-
28		unset_junit_dir,
29		assertz(junit_mode(Directory)).
30
31		iso8601_datetime(ISODatime) :- datime(datime(Year,Month,Day,Hour,Min,Sec)),
32		format_to_codes('~`0t~d~2|-~`0t~d~3+-~`0t~d~3+T~`0t~d~3+:~`0t~d~3+:~`0t~d~3+',
33		[Year,Month,Day,Hour,Min,Sec], ISODatime).
34
35
36
37		% <testcase name="Call" classname="Selfcheck.Module" time="2"><error type="error"></testcase>
38
39		create_junit_result(Name, Time, Verdict, result(Name,TR,Verdict)) :-
40		junit_mode(_),!,
41		convert_to_junit_time(Time,TR).
42		create_junit_result(_Call, _Time, _Verdict, none).
43
44		convert_to_junit_time(T,R) :- number(T),!, R is T / 1000.
45
46		create_and_print_junit_result(SuiteName, Name, Time, Verdict) :-
47		create_junit_result(Name, Time, Verdict,Result),
48		print_junit(SuiteName, [Result]).
49
50		print_junit(SuiteName, Results) :-
51		junit_mode(Dir),!,print_junit2(Dir,SuiteName,Results).
52		print_junit(_SuiteName, _Results).
53
54		:- use_module(tools_strings,[ajoin/2,ajoin_with_sep/3]).
55		:- use_module(tools_files,[put_codes/2]).
56		:- use_module(error_manager).
57		print_junit2(Dir,SuiteNameParts,Results) :-
58		ajoin_with_sep(SuiteNameParts,'.',SuiteName),
59	?	prepare_xml(SuiteName,Results,Codes),
60		open_file(0,Dir,SuiteName,Stream),
61		put_codes(Codes,Stream),
62		close(Stream),!.
63		print_junit2(Dir,SuiteName,_Results) :- add_error(junit_tests,'print_junit failed',Dir:SuiteName).
64
65		:- use_module(tools_meta,[safe_on_exception/3]).
66		open_file(C,Dir,SuiteName,Stream) :- get_process_id(PID),
67		number_codes(C,CC), atom_codes(Num,CC),
68		ajoin([Dir,'/',Num,'_',PID,'_',SuiteName,'.xml'], File),
69		open_file2(C,File,Dir,SuiteName,Stream).
70		open_file2(C,F,D,SN,Stream) :- file_exists(F),!, C1 is C+1, open_file(C1,D,SN,Stream).
71		open_file2(_C,File,_D,_SN,Stream) :-
72		safe_on_exception(E,open(File, write,Stream),
73		(print('### Exception while opening Junit File: '), print(File),nl,
74		add_error(junit_tests,'Junit File Opening Exception: ',File:E), fail)).
75
76		:- use_module(library(process),[process_id/1]).
77		get_process_id(PID) :- process_id(PID),!.
78		get_process_id(PID) :- print('### getting process_id failed'),nl,
79		% this shouldn't happen
80		PID=0.
81
82		prepare_xml(SuiteName,Results,Codes) :-
83		atom_codes(SuiteName,SNCodes),
84		maplist(prepare_testcase_xml(SNCodes), Results,X),
85		% count tests
86		length(Results,TestsNr),
87		number_codes(TestsNr, Tests),
88		% count tests marked as error
89	?	count_results(error(_), Results, ErrorsNr),
90		number_codes(ErrorsNr, Errors),
91		% count skipped tests
92	?	count_results(skip, Results, SkippedNr),
93		number_codes(SkippedNr, Skipped),
94		% sum all test runtimes
95		maplist(extract_times, Results,Times),
96		sumlist(Times, TimeNr),
97		format_to_codes('~6f', [TimeNr], Time),
98		append([element(properties, [], [])|X],
99		[element('system-out',[], []), element('system-err', [], [])], Children),
100		iso8601_datetime(DT),
101		xml_parse(Codes,
102		xml([version="1.0",encoding="UTF-8"],
103		element(testsuite,
104		[name=SNCodes,hostname="Test Runner",tests=Tests,
105		skipped=Skipped,failures="0",
106		errors=Errors,time=Time,timestamp=DT],
107		Children))).
108		prepare_xml(SuiteName,Results,_Codes) :- add_error_fail(junit_tests,'prepare_xml failed',SuiteName:Results).
109
110		prepare_testcase_xml(_SNCodes,Result,_) :- var(Result),!,
111		add_error_fail(junit_tests,'prepare_testcase_xml called on non-ground result',Result).
112		prepare_testcase_xml(SNCodes,Result,element(testcase,R,Error)) :-
113		Result = result(Call,Time,Verdict),
114		R = [name=Name, classname=SNCodes, time=T],
115		write_to_codes(Call,Name),
116		( Verdict=pass -> Error=[]
117		; Verdict=error(E) -> (createError(E,Err), Error=[element(error,['='(type,"Error")],Err)])
118		; Verdict=skip -> Error=[element(skipped,[],[])]),
119		format_to_codes('~6f', [Time], T).
120
121		createError([],[]).
122		createError([E|T],[pcdata(Error)|R]) :- write_to_codes(E,Codes), append(["\n",Codes,"\n"],Error), createError(T,R).
123
124		extract_times(Result,_) :- var(Result),!,
125		add_error_fail(junit_tests,'extract_times called on non-ground result',Result).
126		extract_times(result(_,Time,_),Time).
127
128		count_results(_,Results,_) :- var(Results),!,
129		add_error_fail(junit_tests,'count_results called on non-ground list of results',Results).
130	?	count_results(Type,Results,Sum) :- count_results2(Type, Results, Sum).
131
132		count_results2(_, [], 0).
133		count_results2(Type,[result(_,_,Type)|Tail],Result) :- !, count_results2(Type,Tail,Temp), Result is 1 + Temp.
134	?	count_results2(Type,[result(_,_,_)|Tail],Result) :- !, count_results2(Type,Tail,Result).