Prolog "runner"
/**
* 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
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
/*************************************************************/
/* 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_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).
/****************************************************************/
/* Runner & Measure Batches */
/****************************************************************/
/**
* runner_batch(T):
* The predicate initializes the legend for the tag T, executes
* the currently loaded test cases, collects and summarizes
* the success results under the tag T.
*/
% runner_batch(+Atom)
runner_batch(Tag) :-
sys_aggr_legend(Tag),
fail.
runner_batch(Tag) :-
retractall(result(_,_,_,_,_,Tag,_)),
clause(runner_case(Fun, Arity, Suite, Tests, Case), Body),
(catch(Body, _, fail) -> Data = 1; Data = 0),
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, Data),
fail.
runner_batch(Tag) :-
sys_aggr_batch(Tag).
/**
* measure_batch(T):
* The predicate initializes the legend for the tag T, executes
* the currently loaded test cases, collects and summarizes
* the time measurement results under the tag T.
*/
% measure_batch(+Atom)
measure_batch(Tag) :-
sys_aggr_legend(Tag),
fail.
measure_batch(Tag) :-
retractall(result(_,_,_,_,_,Tag,_)),
clause(runner_case(Fun, Arity, Suite, Tests, Case), Body),
statistics(time, Data1),
(catch(Body, _, fail) -> true; true),
statistics(time, Data2),
Data is Data2-Data1,
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, Data),
fail.
measure_batch(Tag) :-
sys_aggr_batch(Tag).
% sys_aggr_legend(+Atom)
sys_aggr_legend(Tag) :-
retractall(legend_column(Tag, _)),
current_prolog_flag(version, Version),
Major is Version // 10000,
Minor is (Version // 100) rem 100,
Patch is Version rem 100,
current_prolog_flag(host_info, Host),
format_atom('Dogelog Player ~d.~d.~d, ~w', [Major, Minor, Patch, Host], Legend),
assertz(legend_column(Tag, Legend)).
/****************************************************************/
/* Dump Result */
/****************************************************************/
/**
* dump_result(F):
* The predicate writes the test results to the file F. An already
* existing file F is silently overwritten.
*/
% dump_result(+Atom)
dump_result(Name) :-
setup_once_cleanup(
open(Name, write, Stream),
sys_dump_result(Stream),
close(Stream)).
% sys_dump_result(+Stream)
sys_dump_result(Stream) :-
sys_dump_indicator(legend_column/2, Stream),
sys_dump_indicator(result_summary/2, Stream),
sys_dump_indicator(result_suite/3, Stream),
sys_dump_indicator(result_tests/4, Stream),
sys_dump_indicator(result_pred/6, Stream),
sys_dump_indicator(result/7, Stream).
/****************************************************************/
/* Value Aggregation */
/****************************************************************/
% sys_aggr_batch(+Atom)
sys_aggr_batch(Tag) :-
retractall(result_pred(_,_,_,_,Tag,_)),
result(Fun, Arity, Suite, Tests, _, Tag, Value),
sys_aggr_pred(Fun, Arity, Suite, Tests, Tag, Value),
fail.
sys_aggr_batch(Tag) :-
retractall(result_tests(_,_,Tag,_)),
result_pred(_, _, Suite, Tests, Tag, Value),
sys_aggr_tests(Suite, Tests, Tag, Value),
fail.
sys_aggr_batch(Tag) :-
retractall(result_suite(_,Tag,_)),
result_tests(Suite, _, Tag, Value),
sys_aggr_suite(Suite, Tag, Value),
fail.
sys_aggr_batch(Tag) :-
retractall(result_summary(Tag,_)),
result_suite(_, Tag, Value),
sys_aggr_summary(Tag, Value),
fail.
sys_aggr_batch(_).
% sys_aggr_result(+Atom, +Integer, +Atom, +Atom, +Atom, +Atom, +Data)
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, Data) :-
retract(result(Fun, Arity, Suite, Tests, Case, Tag, Data2)), !,
Data3 is Data+Data2,
assertz(result(Fun, Arity, Suite, Tests, Case, Tag, Data3)).
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, Data) :-
assertz(result(Fun, Arity, Suite, Tests, Case, Tag, Data)).
% sys_aggr_pred(+Atom, +Integer, +Atom, +Atom, +Atom, +Atom, +Data)
sys_aggr_pred(Fun, Arity, Suite, Tests, Tag, Data) :-
retract(result_pred(Fun, Arity, Suite, Tests, Tag, Data2)), !,
Data3 is Data+Data2,
assertz(result_pred(Fun, Arity, Suite, Tests, Tag, Data3)).
sys_aggr_pred(Fun, Arity, Suite, Tests, Tag, Data) :-
assertz(result_pred(Fun, Arity, Suite, Tests, Tag, Data)).
% sys_aggr_tests(+Atom, +Atom, +Atom, +Data).
sys_aggr_tests(Suite, Tests, Tag, Data) :-
retract(result_tests(Suite, Tests, Tag, Data2)), !,
Data3 is Data+Data2,
assertz(result_tests(Suite, Tests, Tag, Data3)).
sys_aggr_tests(Suite, Tests, Tag, Data) :-
assertz(result_tests(Suite, Tests, Tag, Data)).
% sys_aggr_suite(+Atom, +Atom, +Data)
sys_aggr_suite(Suite, Tag, Data) :-
retract(result_suite(Suite, Tag, Data2)), !,
Data3 is Data+Data2,
assertz(result_suite(Suite, Tag, Data3)).
sys_aggr_suite(Suite, Tag, Data) :-
assertz(result_suite(Suite, Tag, Data)).
% sys_aggr_summary(+Atom, +Data)
sys_aggr_summary(Tag, Data) :-
retract(result_summary(Tag, Data2)), !,
Data3 is Data+Data2,
assertz(result_summary(Tag, Data3)).
sys_aggr_summary(Tag, Data) :-
assertz(result_summary(Tag, Data)).
/****************************************************************/
/* Dump Values */
/****************************************************************/
% sys_dump_indicator(+Indicator, +Stream)
sys_dump_indicator(F/N, Stream) :- nl(Stream),
writeq(Stream, (:- multifile(F/N))), write(Stream, '.'), nl(Stream),
writeq(Stream, (:- dynamic(F/N))), write(Stream, '.'), nl(Stream),
functor(H, F, N), H,
writeq(Stream, H), write(Stream, '.'), nl(Stream),
fail.
sys_dump_indicator(_, _).