Prolog "runner"

Admin User, created Apr 14. 2024
         
/**
* 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.
*/
/*************************************************************/
/* 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.
% legend_compute(-Atom)
:- multifile legend_compute/1.
% legend_compute(+Atom, -Atom)
:- multifile legend_compute/2.
% measure_time(+Atom, +Integer)
:- multifile measure_time/2.
/*************************************************************/
/* 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.
/****************************************************************/
/* Runner & Measure Batches */
/****************************************************************/
/**
* runner_batch(T):
* The predicate executes the currently loaded test cases, collects
* and summarizes the success results under the tag T.
*/
% runner_batch(+Atom)
runner_batch(Tag) :-
retractall(result(_,_,_,_,_,Tag,_)),
clause(runner_case(Fun, Arity, Suite, Tests, Case), Body),
(catch(Body, _, fail) -> Ok = 1; Ok = 0),
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, Ok),
fail.
runner_batch(Tag) :-
sys_aggr_batch(Tag).
/**
* measure_batch(L):
* The predicate executes the currently loaded test cases, collects
* and summarizes the time measurements under the tags L.
*/
% measure_batch(+List)
measure_batch(Tags) :-
(member(Tag, Tags), retractall(result(_,_,_,_,_,Tag,_)), fail; true),
clause(runner_case(Fun, Arity, Suite, Tests, Case), Body),
sys_measure_collect(Tags, Times1),
(catch(Body, _, fail) -> true; true),
sys_measure_collect(Tags, Times2),
sys_measure_delta(Tags, Times1, Times2, Tag, Time),
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, Time),
fail.
measure_batch(Tags) :-
(member(Tag, Tags), sys_aggr_batch(Tag), fail; true).
% sys_measure_collect(+List, -List)
sys_measure_collect([Tag|Tags], [Time|Times]) :-
measure_time(Tag, Time),
sys_measure_collect(Tags, Times).
sys_measure_collect([], []).
% sys_measure_delta(+List, +List, +List, -Atom, -Integer)
sys_measure_delta([Tag|_], [Time1|_], [Time2|_], Tag, Time) :-
Time is Time2-Time1.
sys_measure_delta([_|Tags], [_|Times1], [_|Times2], Tag, Time) :-
sys_measure_delta(Tags, Times1, Times2, Tag, Time).
/*************************************************************/
/* Legend & Count Batches */
/*************************************************************/
/**
* legend_batch:
* The predicate creates the table legend.
*/
% legend_batch
legend_batch :-
retractall(legend_table(_)),
legend_compute(Legend),
assertz(legend_table(Legend)).
/**
* legend_batch(L):
* The predicate creates the column legends with tags L.
*/
% legend_batch(+List)
legend_batch(Tags) :-
(member(Tag, Tags), retractall(legend_column(Tag,_)), fail; true),
member(Tag, Tags),
legend_compute(Tag, Legend),
assertz(legend_column(Tag, Legend)),
fail.
legend_batch(_).
/**
* count_batch(T):
* The predicate counts the currently loaded test cases, collects
* and summarizes the count results under the tag T.
*/
% count_batch(+Atom)
count_batch(Tag) :-
retractall(result(_,_,_,_,_,Tag,_)),
clause(runner_case(Fun, Arity, Suite, Tests, Case), _),
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, 1),
fail.
count_batch(Tag) :-
sys_aggr_batch(Tag).
/****************************************************************/
/* 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, +Time)
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, Time) :-
retract(result(Fun, Arity, Suite, Tests, Case, Tag, Time2)), !,
sys_aggr_value(Time, Time2, Time3),
assertz(result(Fun, Arity, Suite, Tests, Case, Tag, Time3)).
sys_aggr_result(Fun, Arity, Suite, Tests, Case, Tag, Time) :-
assertz(result(Fun, Arity, Suite, Tests, Case, Tag, Time)).
% sys_aggr_pred(+Atom, +Integer, +Atom, +Atom, +Atom, +Atom, +Time)
sys_aggr_pred(Fun, Arity, Suite, Tests, Tag, Time) :-
retract(result_pred(Fun, Arity, Suite, Tests, Tag, Time2)), !,
sys_aggr_value(Time, Time2, Time3),
assertz(result_pred(Fun, Arity, Suite, Tests, Tag, Time3)).
sys_aggr_pred(Fun, Arity, Suite, Tests, Tag, Time) :-
assertz(result_pred(Fun, Arity, Suite, Tests, Tag, Time)).
% sys_aggr_tests(+Atom, +Atom, +Atom, +Time).
sys_aggr_tests(Suite, Tests, Tag, Time) :-
retract(result_tests(Suite, Tests, Tag, Time2)), !,
sys_aggr_value(Time, Time2, Time3),
assertz(result_tests(Suite, Tests, Tag, Time3)).
sys_aggr_tests(Suite, Tests, Tag, Time) :-
assertz(result_tests(Suite, Tests, Tag, Time)).
% sys_aggr_suite(+Atom, +Atom, +Time)
sys_aggr_suite(Suite, Tag, Time) :-
retract(result_suite(Suite, Tag, Time2)), !,
sys_aggr_value(Time, Time2, Time3),
assertz(result_suite(Suite, Tag, Time3)).
sys_aggr_suite(Suite, Tag, Time) :-
assertz(result_suite(Suite, Tag, Time)).
% sys_aggr_summary(+Atom, +Time)
sys_aggr_summary(Tag, Time) :-
retract(result_summary(Tag, Time2)), !,
sys_aggr_value(Time, Time2, Time3),
assertz(result_summary(Tag, Time3)).
sys_aggr_summary(Tag, Time) :-
assertz(result_summary(Tag, Time)).
% sys_aggr_value(+Value, +Value, -Value)
sys_aggr_value(A - B, C - D, E - F) :- !,
E is A + C,
F is B + D.
sys_aggr_value(A, C, E) :-
E is A + C.
/****************************************************************/
/* Dump Batch */
/****************************************************************/
/**
* dump_meta(F):
* The predicate writes the test results to the file F.
*/
% dump_meta(+Atom)
dump_meta(Name) :-
open(Name, write, Stream),
sys_dump_indicator(legend_table/1, Stream),
close(Stream).
/**
* dump_result(F):
* The predicate writes the test results to the file F.
*/
% dump_result(+Atom)
dump_result(Name) :-
open(Name, write, 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),
close(Stream).
% 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(_, _).
/****************************************************************/
/* Unload Batch */
/****************************************************************/
/**
* unload_meta:
* The predicate unloads the meta data.
*/
% unload_meta
unload_meta :-
retractall(legend_table(_)).
/**
* unload_result:
* The predicate unloads the test results.
*/
% unload_result
unload_result :-
retractall(legend_column(_,_)),
retractall(result_summary(_,_)),
retractall(result_suite(_,_,_)),
retractall(result_tests(_,_,_,_)),
retractall(result_pred(_,_,_,_,_,_)),
retractall(result(_,_,_,_,_,_,_)).