junit_tests

convert_to_junit_time(T,R) :- number(T),!, R is T / 1000.

count_results(_,Results,_) :- var(Results),!,
    add_error_fail(junit_tests,'count_results called on non-ground list of results',Results).

count_results(Type,Results,Sum) :- count_results2(Type, Results, Sum).

count_results2(_, [], 0).

count_results2(Type,[result(_,_,Type)|Tail],Result) :- !, count_results2(Type,Tail,Temp), Result is 1 + Temp.

count_results2(Type,[result(_,_,_)|Tail],Result) :- !, count_results2(Type,Tail,Result).

createError([],[]).

createError([E|T],[pcdata(Error)|R]) :- write_to_codes(E,Codes), append(["\n",Codes,"\n"],Error), createError(T,R).

create_and_print_junit_result(SuiteName, Name, Time, Verdict) :-
    create_junit_result(Name, Time, Verdict,Result),
    print_junit(SuiteName, [Result]).

create_junit_result(Name, Time, Verdict, result(Name,TR,Verdict)) :-
    junit_mode(_),!,
    convert_to_junit_time(Time,TR).

create_junit_result(_Call, _Time, _Verdict, none).

extract_times(Result,_) :- var(Result),!,
    add_error_fail(junit_tests,'extract_times called on non-ground result',Result).

extract_times(result(_,Time,_),Time).

get_process_id(PID) :- process_id(PID),!.

get_process_id(PID) :- print('### getting process_id failed'),nl,
    % this shouldn't happen
    PID=0.

iso8601_datetime(ISODatime) :- datime(datime(Year,Month,Day,Hour,Min,Sec)),
    format_to_codes('~`0t~d~2|-~`0t~d~3+-~`0t~d~3+T~`0t~d~3+:~`0t~d~3+:~`0t~d~3+',
    [Year,Month,Day,Hour,Min,Sec], ISODatime).

open_file(C,Dir,SuiteName,Stream) :- get_process_id(PID),
    number_codes(C,CC), atom_codes(Num,CC),
    ajoin([Dir,'/',Num,'_',PID,'_',SuiteName,'.xml'], File),
    open_file2(C,File,Dir,SuiteName,Stream).

open_file2(C,F,D,SN,Stream) :- file_exists(F),!, C1 is C+1, open_file(C1,D,SN,Stream).

open_file2(_C,File,_D,_SN,Stream) :-
    safe_on_exception(E,open(File, write,Stream),
    (print('### Exception while opening Junit File: '), print(File),nl,
    add_error(junit_tests,'Junit File Opening Exception: ',File:E), fail)).

prepare_testcase_xml(_SNCodes,Result,_) :- var(Result),!,
    add_error_fail(junit_tests,'prepare_testcase_xml called on non-ground result',Result).

prepare_testcase_xml(SNCodes,Result,element(testcase,R,Error)) :-
    Result = result(Call,Time,Verdict),
    R = [name=Name, classname=SNCodes, time=T],
    write_to_codes(Call,Name),
    ( Verdict=pass -> Error=[]
    ; Verdict=error(E) -> (createError(E,Err), Error=[element(error,['='(type,"Error")],Err)])
    ; Verdict=skip -> Error=[element(skipped,[],[])]),
    format_to_codes('~6f', [Time], T).

prepare_xml(SuiteName,Results,Codes) :-
    atom_codes(SuiteName,SNCodes),
    maplist(prepare_testcase_xml(SNCodes), Results,X),
    % count tests
    length(Results,TestsNr),
    number_codes(TestsNr, Tests),
    % count tests marked as error
    count_results(error(_), Results, ErrorsNr),
    number_codes(ErrorsNr, Errors),
    % count skipped tests
    count_results(skip, Results, SkippedNr),
    number_codes(SkippedNr, Skipped),
    % sum all test runtimes
    maplist(extract_times, Results,Times),
    sumlist(Times, TimeNr),
    format_to_codes('~6f', [TimeNr], Time),
    append([element(properties, [], [])|X],
    [element('system-out',[], []), element('system-err', [], [])], Children),
    iso8601_datetime(DT),
    xml_parse(Codes,
    xml([version="1.0",encoding="UTF-8"],
    element(testsuite,
    [name=SNCodes,hostname="Test Runner",tests=Tests,
    skipped=Skipped,failures="0",
    errors=Errors,time=Time,timestamp=DT],
    Children))).

prepare_xml(SuiteName,Results,_Codes) :- add_error_fail(junit_tests,'prepare_xml failed',SuiteName:Results).

print_junit(SuiteName, Results) :-
    junit_mode(Dir),!,print_junit2(Dir,SuiteName,Results).

print_junit(_SuiteName, _Results).

print_junit2(Dir,SuiteNameParts,Results) :-
    ajoin_with_sep(SuiteNameParts,'.',SuiteName),
    prepare_xml(SuiteName,Results,Codes),
    open_file(0,Dir,SuiteName,Stream),
    put_codes(Codes,Stream),
    close(Stream),!.

print_junit2(Dir,SuiteName,_Results) :- add_error(junit_tests,'print_junit failed',Dir:SuiteName).

set_junit_dir(Directory) :-
    unset_junit_dir,
    assertz(junit_mode(Directory)).

unset_junit_dir :- retractall(junit_mode(_)).