Prolog "exec"
/**
* 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.
*/
runner_file(extra, exec, 'XLOG 3.1 async').
/****************************************************************/
/* kernel.p extras */
/****************************************************************/
/* shield(X) */
runner_pred(shield,1, extra, exec, 'XLOG 3.1.2').
runner_case(shield,1, extra, exec, 'XLOG 3.1.2, XLOG 1') :-
current_prolog_flag(async_mode, X),
X == on.
runner_case(shield,1, extra, exec, 'XLOG 3.1.2, XLOG 2') :-
shield(current_prolog_flag(async_mode, X)),
X == off.
runner_case(shield,1, extra, exec, 'XLOG 3.1.2, XLOG 3') :-
catch(shield(throw(foo)), E, true),
E == foo.
runner_case(shield,1, extra, exec, 'XLOG 3.1.2, XLOG 4') :-
\+ shield(fail).
/* unshield(X) */
runner_pred(unshield,1, extra, exec, 'XLOG 3.1.3').
runner_case(unshield,1, extra, exec, 'XLOG 3.1.3, XLOG 1') :-
shield(unshield(current_prolog_flag(async_mode, X))),
X == on.
runner_case(unshield,1, extra, exec, 'XLOG 3.1.3, XLOG 2') :-
unshield((X=1;X=2)),
X == 1.
runner_case(unshield,1, extra, exec, 'XLOG 3.1.3, XLOG 3') :-
findall(X,unshield((X=1;X=2)),[_,X|_]),
X == 2.
/* once_cleanup(X, Y) */
runner_pred(once_cleanup,2, extra, exec, 'XLOG 3.1.4').
runner_case(once_cleanup,2, extra, exec, 'XLOG 3.1.4, XLOG 1') :-
once_cleanup(true, current_prolog_flag(async_mode, X)),
X == off.
runner_case(once_cleanup,2, extra, exec, 'XLOG 3.1.4, XLOG 2') :-
catch(once_cleanup(throw(foo), true), E, true),
E == foo.
runner_case(once_cleanup,2, extra, exec, 'XLOG 3.1.4, XLOG 3') :-
\+ once_cleanup(fail, true).
/* setup_once_cleanup(X, Y, Z) */
runner_pred(setup_once_cleanup,3, extra, exec, 'XLOG 3.1.5').
runner_case(setup_once_cleanup,3, extra, exec, 'XLOG 3.1.5, XLOG 1') :-
setup_once_cleanup(true, current_prolog_flag(async_mode, X), true),
X == on.
runner_case(setup_once_cleanup,3, extra, exec, 'XLOG 3.1.5, XLOG 2') :-
setup_once_cleanup(true, (X=1;X=2), true),
X == 1.
runner_case(setup_once_cleanup,3, extra, exec, 'XLOG 3.1.5, XLOG 3') :-
\+ findall(X,setup_once_cleanup(true, (X=1;X=2), true),[_,X|_]).
/****************************************************************/
/* kernel.p extras */
/****************************************************************/
% time_sleep(+Integer)
time_sleep(S) :-
current_prolog_flag(dialect, gprolog), !,
T is S/1000,
(T >= 0 -> sleep(T); throw(error(existence_error(not_supported, T), _))).
time_sleep(S) :-
sleep(S).
% time_trap(+Term, -Term)
time_trap(G, E) :-
current_prolog_flag(dialect, gprolog), !,
catch(G, error(E,_), true).
time_trap(G, E) :-
sys_trap(G, error(E,_), true).
% time_once(+Term, -Integer)
time_once(G, C) :-
current_prolog_flag(dialect, gprolog), !,
statistics(real_time, [A|_]),
time_trap(G, _),
statistics(real_time, [B|_]),
C is B-A.
time_once(G, C) :-
statistics(time, A),
time_trap(G, _),
statistics(time, B),
C is B-A.
/* sleep(X) */
runner_pred(sleep,1, extra, exec, 'XLOG 3.1.6').
runner_case(sleep,1, extra, exec, 'XLOG 3.1.6, XLOG 1') :-
time_once(time_sleep(1000), X),
X > 750.
runner_case(sleep,1, extra, exec, 'XLOG 3.1.6, XLOG 2') :-
catch(time_sleep(-1), error(E,_), true),
E == domain_error(not_less_than_zero, -1).
/* call_with_time_limit(X, Y) */
runner_pred(call_with_time_limit,2, extra, exec, 'XLOG 3.1.7').
runner_case(call_with_time_limit,2, extra, exec, 'XLOG 3.1.7, XLOG 1') :-
time_once(call_with_time_limit(500, time_sleep(1000)), X),
X < 750.
runner_case(call_with_time_limit,2, extra, exec, 'XLOG 3.1.7, XLOG 2') :-
time_trap(call_with_time_limit(500, time_sleep(1000)), E),
E == system_error(timelimit_exceeded).
runner_case(call_with_time_limit,2, extra, exec, 'XLOG 3.1.7, XLOG 3') :-
catch(call_with_time_limit(-1, foo), error(E,_), true),
E == domain_error(not_less_than_zero, -1).