Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2024 XLOG Technologies AG
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Dogelog is a deposited trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(sequence)).
:- ensure_loaded(library(util/format)).
:- ensure_loaded(library(tester/runner)).
:- ensure_loaded(library(util/files)).
:- ensure_loaded(library(misc/markup)).
/*************************************************************/
/* Tests Interface */
/*************************************************************/
% runner_folder(-Atom, -Atom)
:- multifile runner_folder/2.
% runner_file(-Atom, -Atom, -Atom)
:- multifile runner_file/3.
% runner_pred(-Atom, -Integer, -Atom, -Atom, -Atom)
:- multifile runner_pred/5.
% runner_case(-Atom, -Integer, -Atom, -Atom, -Atom)
:- multifile runner_case/5.
:- dynamic runner_case/5.
/*************************************************************/
/* Results Interface */
/*************************************************************/
% legend_table(-Atom)
:- multifile legend_table/1.
:- dynamic legend_table/1.
% legend_column(+Atom, -Atom)
:- multifile legend_column/2.
:- dynamic legend_column/2.
% result_summary(-Atom, -Data)
:- multifile result_summary/2.
:- dynamic result_summary/2.
% result_suite(-Atom, -Atom, -Data)
:- multifile result_suite/3.
:- dynamic result_suite/3.
% result_tests(-Atom, -Atom, -Atom, -Data)
:- multifile result_tests/4.
:- dynamic result_tests/4.
% result_pred(-Atom, -Integer, -Atom, -Atom, -Atom, -Data)
:- multifile result_pred/6.
:- dynamic result_pred/6.
% result(-Atom, -Integer, -Atom, -Atom, -Case, -Atom, -Data)
:- multifile result/7.
:- dynamic result/7.
/*************************************************************/
/* Multi Root Report Batch */
/*************************************************************/
/**
* report_batch(D, L, O):
* The predicate succeeds in writing HTML summary and results
* pages for the tag list L into the directory D. The parameter
* O is the options list. The report generator silently
* overwrites already existing HTML pages.
*/
% report_batch(+Atom, +List, +List)
report_batch(Dir, Tags, Opts) :-
report_begin(Dir, Tags, Opts),
report_add(Dir, Tags, Opts),
report_end(Dir, Tags, Opts).
/**
* report_begin(D, L, O):
* The predicate succeeds in writing a HTML summary header
* for the tag list L into the directory D. The parameter
* O is the options list. The report generator silently
* overwrites already existing HTML pages.
*/
% report_begin(+Atom, +List, +List)
report_begin(Dir, _, Opts) :-
sys_report_default(Date0),
decode_report_opts(Opts, v('','',Date0,'result/','',0), v(_,Title,Date,_,_,_)),
sys_main_begin(Dir, Title, Date).
/**
* report_add(D, L, O):
* The predicate succeeds in appending a HTML summery enty
* and writing result pages for the tag list L into the directory D.
* The parameter O is the options list. The report generator silently
* overwrites already existing HTML pages.
*/
% report_add(+Atom, +List, +List)
report_add(Dir, Tags, Opts) :-
sys_report_default(Date0),
decode_report_opts(Opts, v('','',Date0,'result/','',0), v(Base,_,Date,Root,Subtitle,Flags)),
sys_main_add(Dir, Tags, Root, Subtitle, Flags),
atom_concat(Dir, Root, Dir2),
sys_result_batch(Dir2, Tags, Date, Subtitle),
sys_folders_batch(Dir2, Tags, Date),
sys_files_batch(Dir2, Tags, Base, Date).
/**
* report_end(D, L, O):
* The predicate succeeds in appending a HTML summary footer
* for the tag list L into the directory D. The parameter
* O is the options list. The report generator silently
* overwrites already existing HTML pages.
*/
% report_end(+Atom, +List, +List)
report_end(Dir, _, Opts) :-
sys_report_default(Date0),
decode_report_opts(Opts, v('','',Date0,'result/','',0), v(_,_,_,_,_,_)),
sys_main_end(Dir).
% sys_report_default(-Date)
sys_report_default(Date) :-
statistics(wall, Time),
sys_time_atom('%Y-%m-%d %H:%M:%S', Time, Date).
/*************************************************************/
/* Main Page */
/*************************************************************/
% sys_main_begin(+Atom, +Atom, +Atom)
sys_main_begin(Dir, Title, Date) :-
format_atom('~w', [Dir], Dst),
ensure_directory(Dst),
format_atom('~wpackage.html', [Dir], Name),
open(Name, write, S), dom_output_new(S, T),
sys_begin_html2(Title, '../../../styles.css', T),
tag_format(T, '<h1 date="~a">', [Date]),
put_atom(T, 'Summary '), put_atom(T, Title),
tag(T, '</h1>'),
close(T),
fail.
sys_main_begin(_, _, _).
% sys_main_add(+Atom, +List, +Atom, +Atom, +Integer)
sys_main_add(Dir, Tags, Root, Subtitle, Flags) :-
format_atom('~wpackage.html', [Dir], Name),
open(Name, append, S), dom_output_new(S, T),
ir_indent_set(S, 6),
sys_main_list2(Tags, Root, Subtitle, T),
(Flags /\ 1 =:= 0 -> sys_legend2(Tags, T); true),
close(T),
fail.
sys_main_add(_, _, _, _, _).
% sys_main_end(+Atom)
sys_main_end(Dir) :-
format_atom('~wpackage.html', [Dir], Name),
open(Name, append, S), dom_output_new(S, T),
ir_indent_set(S, 6),
sys_end_html2(T),
close(T),
fail.
sys_main_end(_).
% sys_main_list2(+List, +Atom, +Atom, +Stream)
sys_main_list2(Tags, Root, Subtitle, T) :-
tag(T, '<h3>'),
put_atom(T, 'Results '), put_atom(T, Subtitle),
tag(T, '</h3>'),
tag(T, '<table class="rowtable">'),
tag(T, '<tr class="headrow">'),
tag(T, '<th style="width: 16em">'), put_atom(T, 'Folder'), tag(T, '</th>'),
(member(Tag, Tags),
tag(T, '<th style="width: 4em">'), put_atom(T, Tag), tag(T, '</th>'),
fail; true),
tag(T, '</tr>'),
sys_main_member2(Tags, Root, T),
tag(T, '<tr class="headrow">'),
tag(T, '<td>'), put_atom(T, 'Total'), tag(T, '</td>'),
(member(Tag, Tags),
result_summary(Tag, Z),
sys_data_cell2(Z, T), fail; true),
tag(T, '</tr>'),
tag(T, '</table>'),
fail.
sys_main_list2(_, _, _, _).
% sys_main_member2(+List, +Atom, +Stream)
sys_main_member2(Tags, Root, T) :-
call_nth(runner_folder(E, _), I),
sys_zebra_row2(I, T),
format_atom('~wpackage.html#~c', [Root, E], H),
tag(T, '<td>'),
tag_format(T, '<a href="~a">', [H]), put_atom(T, E), tag(T, '</a>'),
tag(T, '</td>'),
(member(Tag, Tags),
result_suite(E, Tag, Z),
sys_data_cell2(Z, T), fail; true),
tag(T, '</tr>'),
fail.
sys_main_member2(_, _, _).
/*************************************************************/
/* Result Page */
/*************************************************************/
% sys_result_batch(+Atom, +List, +Atom)
sys_result_batch(Dir, Tags, Date, Subtitle) :-
format_atom('~w', [Dir], Dst),
ensure_directory(Dst),
format_atom('~wpackage.html', [Dir], Name),
open(Name, write, S), dom_output_new(S, T),
sys_begin_html2(Subtitle, '../../../styles.css', T),
tag_format(T, '<h1 date="~a">', [Date]),
put_atom(T, 'Results '), put_atom(T, Subtitle),
tag(T, '</h1>'),
sys_result_list2(Tags, T),
sys_legend2(Tags, T),
sys_end_html2(T),
close(T),
fail.
sys_result_batch(_, _, _, _).
% sys_result_list2(+List, +Stream)
sys_result_list2(Tags, T) :-
call_nth(runner_folder(E, _), J),
tag(T, '<h3>'),
tag_format(T, '<a name="~a">', [E]), tag(T, '</a>'),
put_atom(T, 'Folder '), put_atom(T, E), tag(T, '</h3>'),
tag(T, '<table class="rowtable">'),
tag(T, '<tr class="headrow">'),
tag(T, '<th style="width: 16em">'), put_atom(T, 'File'), tag(T, '</th>'),
(member(Tag, Tags),
tag(T, '<th style="width: 4em">'), put_atom(T, Tag), tag(T, '</th>'),
fail; true),
tag(T, '</tr>'),
sys_result_member2(E, J, Tags, T),
tag(T, '<tr class="headrow">'),
tag(T, '<td>'), put_atom(T, 'Total'), tag(T, '</td>'),
(member(Tag, Tags),
result_suite(E, Tag, Z),
sys_data_cell2(Z, T), fail; true),
tag(T, '</tr>'),
tag(T, '</table>'),
fail.
sys_result_list2(_, _).
% sys_result_member2(+Atom, +Integer, +List, +Stream)
sys_result_member2(E, J, Tags, T) :-
call_nth(runner_file(E, D, Title), I),
sys_zebra_row2(I, T),
format_atom('0~d_~c/package.html#~c', [J, E, D], H),
tag(T, '<td>'),
tag_format(T, '<a href="~a">', [H]),
put_atom(T, Title),
tag(T, '</a>'),
tag(T, '</td>'),
(member(Tag, Tags),
result_tests(E, D, Tag, Z),
sys_data_cell2(Z, T), fail; true),
tag(T, '</tr>'),
fail.
sys_result_member2(_, _, _, _).
/*************************************************************/
/* Folders Pages */
/*************************************************************/
% sys_folders_batch(+Atom, +List, +Atom)
sys_folders_batch(Dir, Tags, Date) :-
call_nth(runner_folder(E, _), J),
format_atom('~w0~d_~w', [Dir, J, E], Dst),
ensure_directory(Dst),
format_atom('~w0~d_~w/package.html', [Dir, J, E], Name),
open(Name, write, S), dom_output_new(S, T),
sys_begin_html2(E, '../../../../styles.css', T),
flush_output(T),
tag_format(T, '<h1 date="~a">', [Date]),
put_atom(T, 'Folder '), put_atom(T, E),
tag(T, '</h1>'),
sys_folder_list2(E, Tags, T),
sys_legend2(Tags, T),
sys_end_html2(T),
close(T),
fail.
sys_folders_batch(_, _, _).
% sys_folder_list2(+Atom, +List, +Stream)
sys_folder_list2(E, Tags, T) :-
call_nth(runner_file(E, D, Title), L),
tag(T, '<h3>'),
tag_format(T, '<a name="~a">', [D]), tag(T, '</a>'),
put_atom(T, 'File '), put_atom(T, Title), tag(T, '</h3>'),
tag(T, '<table class="rowtable">'),
tag(T, '<tr class="headrow">'),
tag(T, '<th style="width: 16em">'), put_atom(T, 'Predicate'), tag(T, '</th>'),
(member(Tag, Tags),
tag(T, '<th style="width: 4em">'), put_atom(T, Tag), tag(T, '</th>'),
fail; true),
tag(T, '</tr>'),
sys_folder_member2(E, D, L, Tags, T),
tag(T, '<tr class="headrow">'),
tag(T, '<td>'), put_atom(T, 'Total'), tag(T, '</td>'),
(member(Tag, Tags),
result_tests(E, D, Tag, Z),
sys_data_cell2(Z, T), fail; true),
tag(T, '</tr>'),
tag(T, '</table>'),
fail.
sys_folder_list2(_, _, _).
% sys_folder_member2(+Atom, +Atom, +Integer, +List, +Stream)
sys_folder_member2(E, D, L, Tags, T) :-
call_nth(runner_pred(F, N, E, D, _), I),
sys_zebra_row2(I, T),
format_atom('0~d_~c.html#~c/~d', [L,D,F,N], H),
tag(T, '<td>'),
tag_format(T, '<a href="~a">', [H]),
write(T, F/N),
tag(T, '</a>'),
tag(T, '</td>'),
(member(Tag, Tags),
result_pred(F, N, E, D, Tag, Z),
sys_data_cell2(Z, T), fail; true),
tag(T, '</tr>'),
fail.
sys_folder_member2(_, _, _, _, _).
/*************************************************************/
/* Files Pages */
/*************************************************************/
% sys_files_batch(+Atom, +List, +Atom, +Atom)
sys_files_batch(Dir, Tags, Base, Date) :-
call_nth(runner_folder(E, _), J),
call_nth(runner_file(E, D, Title), L),
format_atom('~w0~d_~w/0~d_~w.html', [Dir, J, E, L, D], Name),
open(Name, write, S), dom_output_new(S, T),
sys_begin_html2(D, '../../../../styles.css', T),
tag_format(T, '<h1 date="~a">', [Date]),
put_atom(T, 'File '), put_atom(T, Title),
tag(T, '</h1>'),
sys_file_list2(E, D, Tags, Base, T),
sys_legend2(Tags, T),
sys_end_html2(T),
close(T),
fail.
sys_files_batch(_, _, _, _).
% sys_file_list2(+Atom, +Atom, +List, +Atom, +Stream)
sys_file_list2(E, D, Tags, Base, T) :-
runner_pred(F, N, E, D, _),
tag(T, '<h3>'), tag_format(T, '<a name="~a/~d">', [F,N]), tag(T, '</a>'),
put_atom(T, 'Predicate '), write(T, F/N), tag(T, '</h3>'),
tag(T, '<table class="rowtable">'),
tag(T, '<tr class="headrow">'),
tag(T, '<th style="width: 16em">'), put_atom(T, 'Case'), tag(T, '</th>'),
(member(Tag, Tags),
tag(T, '<th style="width: 4em">'), put_atom(T, Tag), tag(T, '</th>'),
fail; true),
tag(T, '</tr>'),
sys_file_member2(F, N, E, D, Tags, Base, T),
tag(T, '<tr class="headrow">'),
tag(T, '<td>'), put_atom(T, 'Total'), tag(T, '</td>'),
(member(Tag, Tags),
result_pred(F, N, E, D, Tag, Z),
sys_data_cell2(Z, T), fail; true),
tag(T, '</tr>'),
tag(T, '</table>'),
fail.
sys_file_list2(_, _, _, _, _).
% sys_file_member2(+Atom, +Integer, +Atom, +Atom, +List, +Atom, +Stream)
sys_file_member2(F, N, E, D, Tags, Base, T) :-
call_nth(clause(runner_case(F, N, E, D, C), _), I),
sys_zebra_row2(I, T),
format_atom('~c~c/~c.html#~c', [Base, E, D, C], H),
tag(T, '<td>'),
tag_format(T, '<a href="~a">', [H]), put_atom(T, C), tag(T, '</a>'),
tag(T, '</td>'),
(member(Tag, Tags),
result(F, N, E, D, C, Tag, Z),
sys_data_cell2(Z, T), fail; true),
tag(T, '</tr>'),
fail.
sys_file_member2(_, _, _, _, _, _, _).
/*************************************************************/
/* Files Utility */
/*************************************************************/
/**
* sys_begin_html2(T, C, T):
* The predicate succeeds. As a side effect it writes a HTML page
* header with title T and style sheet C to the stream T.
*/
% sys_begin_html2(+Atom, +Atom, +Stream)
sys_begin_html2(Title, C, T) :-
format_atom('~c', [C], H),
tag(T, '<html author="7">'),
tag(T, '<head>'),
tag(T, '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>'),
tag(T, '<title editable="nocomment">'), put_atom(T, Title), tag(T, '</title>'),
tag_format(T, '<link rel="stylesheet" href="~a"/>', [H]),
tag(T, '</head>'),
tag(T, '<body class="showbody">').
/**
* sys_end_html2(T):
* The predicate succeeds. As a side effect it writes a HTML
* page footer to the stream T.
*/
% sys_end_html2(+Stream)
sys_end_html2(T) :-
tag(T, '</body>'),
tag(T, '</html>').
/*************************************************************/
/* Legend */
/*************************************************************/
/**
* sys_legend2(L, T):
* The predicate succeeds. As a side effect it writes the
* table legend and the column legend for each tag in the list L,
* to the stream T.
*/
% sys_legend2(+List, +Stream)
sys_legend2(Tags, T) :-
tag(T, '<h3>'), put_atom(T, 'Legend'), tag(T, '</h3>'),
legend_table(Legend),
tag(T, '<p>'), put_atom(T, Legend), tag(T, '</p>'),
sys_legend_column2(Tags, T).
% sys_legend_column2(+List, +Stream)
sys_legend_column2(Tags, T) :-
tag(T, '<table>'),
member(Tag, Tags),
legend_column(Tag, Legend),
tag(T, '<tr>'),
tag(T, '<td style="width: 4em">'), put_atom(T, Tag), tag(T, '</td>'),
tag(T, '<td style="width: 32em">'), put_atom(T, Legend), tag(T, '</td>'),
tag(T, '</tr>'),
fail.
sys_legend_column2(_, T) :-
tag(T, '</table>').
/***************************************************************/
/* Table Styling */
/***************************************************************/
/**
* sys_zebra_row2(I, T):
* The predicate succeeds. As a side effect it writes the
* start of a table row, alternating between two styles
* to the stream S.
*/
% sys_zebra_row2(+Integer, +Stream)
sys_zebra_row2(N, T) :-
1 =:= N mod 2, !, tag(T, '<tr class="normrow">').
sys_zebra_row2(_, T) :-
tag(T, '<tr class="oddrow">').
/**
* sys_data_cell2(P, T):
* The predicate succeeds. As a side effect it writes the Ok and Nok
* value of the given pair P to the stream S.
*/
% sys_data_cell2(+OkNok, +Stream)
sys_data_cell2(V, _) :- var(V),
throw(error(instantiation_error,_)).
sys_data_cell2(A - B, T) :- integer(A), integer(B), !,
tag(T, '<td style="text-align: right">'),
write(T, A), write(T, ' '), write(T, B),
tag(T, '</td>').
sys_data_cell2(A, T) :- integer(A), !,
tag(T, '<td style="text-align: right">'),
write(T, A),
tag(T, '</td>').
sys_data_cell2(V, _) :-
throw(error(type_error(data_cell, V),_)).
/*******************************************************************/
/* Decode Report Options */
/*******************************************************************/
% decode_report_opts(+List, +Tuple, -Tuple)
decode_report_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
decode_report_opts([X|L], I, O) :- !,
decode_report_opt(X, I, H),
decode_report_opts(L, H, O).
decode_report_opts([], H, H) :- !.
decode_report_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% decode_report_opt(+Option, +Tuple, -Tuple)
decode_report_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
decode_report_opt(tests(A), v(_,Y,Z,T,V,W), v(A,Y,Z,T,V,W)) :- !,
sys_check_atom(A).
decode_report_opt(title(A), v(X,_,Z,T,V,W), v(X,A,Z,T,V,W)) :- !,
sys_check_atom(A).
decode_report_opt(date(A), v(X,Y,_,T,V,W), v(X,Y,A,T,V,W)) :- !,
sys_check_atom(A).
decode_report_opt(root(A), v(X,Y,Z,_,V,W), v(X,Y,Z,A,V,W)) :- !,
sys_check_atom(A).
decode_report_opt(subtitle(A), v(X,Y,Z,T,_,W), v(X,Y,Z,T,A,W)) :- !,
sys_check_atom(A).
decode_report_opt(multi(B), v(X,Y,Z,T,V,F), v(X,Y,Z,T,V,G)) :- !,
sys_opt_boolean(B, 1, F, G).
decode_report_opt(O, _, _) :-
throw(error(type_error(report_option,O),_)).