/** * 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(_, _).