Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 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
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
/**
* Source of test cases are the following standards:
* - Prolog General Core ISO/IEC 13211-1
*/
runner_file(control, logical, 'ISO 7.8 cond').
/****************************************************************/
/* Logical Predicates */
/****************************************************************/
/* A, B */
runner_pred(',', 2, control, logical, 'ISO 7.8.5.4').
runner_case(',', 2, control, logical, 'ISO 7.8.5.4, ISO 1') :-
\+ (X = 1, var(X)).
runner_case(',', 2, control, logical, 'ISO 7.8.5.4, ISO 2') :-
var(X), X = 1, X == 1.
runner_case(',', 2, control, logical, 'ISO 7.8.5.4, ISO 3') :-
X = true, call(X).
/* A; B */
runner_pred(;, 2, control, logical, 'ISO 7.8.6.4').
runner_case(;, 2, control, logical, 'ISO 7.8.6.4, ISO 1') :-
true ; fail.
runner_case(;, 2, control, logical, 'ISO 7.8.6.4, ISO 2') :-
\+ (!, fail; true).
runner_case(;, 2, control, logical, 'ISO 7.8.6.4, ISO 3') :-
!; call(3).
runner_case(;, 2, control, logical, 'ISO 7.8.6.4, ISO 4a') :-
(X = 1, !; X = 2), X == 1.
runner_case(;, 2, control, logical, 'ISO 7.8.6.4, ISO 4b') :-
findall(X,(X = 1, !; X = 2),[_]).
runner_case(;, 2, control, logical, 'ISO 7.8.6.4, ISO 5a') :-
(X = 1; X = 2), (true ; !), X == 1.
runner_case(;, 2, control, logical, 'ISO 7.8.6.4, ISO 5b') :-
findall(X,((X = 1; X = 2), (true ; !)),[_,X|_]), X == 1.
runner_case(;, 2, control, logical, 'ISO 7.8.6.4, ISO 5c') :-
findall(X,((X = 1; X = 2), (true ; !)),[_,_]).
/* A -> B */
runner_pred(->, 2, control, logical, 'ISO 7.8.7.4').
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 1') :-
true -> true.
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 2') :-
\+ (true -> fail).
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 3') :-
\+ (fail -> true).
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 4a') :-
(true -> X = 1), X == 1.
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 4b') :-
findall(X, (true -> X = 1), [_]).
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 5a') :-
((X = 1; X = 2) -> true), X == 1.
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 5b') :-
findall(X, ((X = 1; X = 2) -> true), [_]).
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 6a') :-
(true -> (X = 1; X = 2)), X == 1.
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 6b') :-
findall(X, (true -> (X = 1; X = 2)), [_,X|_]), X == 2.
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, ISO 6c') :-
findall(X, (true -> (X = 1; X = 2)), [_,_]).
runner_case(->, 2, control, logical, 'ISO 7.8.7.4, XLOG 1') :-
findall(X-Y, ((Y = 1;Y = 2), ((X = 1, !; X = 2) -> true)), [_,_]).
/* A -> B ; C */
runner_pred(if_then_else, 3, control, logical, 'ISO 7.8.8.4, Corrigendum 1').
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 1') :-
true -> true; fail.
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 2') :-
fail -> true; true.
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 3') :-
\+ (true -> fail; fail).
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 4') :-
\+ (fail -> true; fail).
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 5') :-
(true -> X = 1; X = 2), X == 1.
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 6') :-
(fail -> X = 1; X = 2), X == 2.
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 7a') :-
(true -> (X = 1; X = 2); true), X == 1.
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 7b') :-
findall(X, (true -> (X = 1; X = 2); true),[_,X|_]), X == 2.
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 7c') :-
findall(X, (true -> (X = 1; X = 2); true),[_,_]).
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 8a') :-
((X = 1; X = 2) -> true; true), X == 1.
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 8b') :-
findall(X, ((X = 1; X = 2) -> true; true), [_]).
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, ISO 9') :-
(! -> fail), true; true.
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, XLOG 1') :-
findall(X-Y, ((Y = 1; Y = 2), ((X = 1; X = 2) -> true; true)), [_,_]).
runner_case(if_then_else, 3, control, logical, 'ISO 7.8.8.4, XLOG 2') :-
findall(X-Y, ((Y = 1; Y = 2), ((X = 1, !; X = 2) -> true; true)), [_,_]).
/****************************************************************/
/* Bootstrapped Controls */
/****************************************************************/
a(1).
a(2).
c(2).
/* \+ A */
runner_pred(\+, 1, control, logical, 'ISO 8.15.1.4').
runner_case(\+, 1, control, logical, 'ISO 8.15.1.4, ISO 1') :-
\+ \+ true.
runner_case(\+, 1, control, logical, 'ISO 8.15.1.4, ISO 2') :-
\+ \+ !.
runner_case(\+, 1, control, logical, 'ISO 8.15.1.4, ISO 3') :-
\+ (!, fail).
runner_case(\+, 1, control, logical, 'ISO 8.15.1.4, ISO 4') :-
\+ (4 = 5).
runner_case(\+, 1, control, logical, 'ISO 8.15.1.4, XLOG 1') :-
Z = !, \+( (Z = !, a(X), Z, c(X)) ).
runner_case(\+, 1, control, logical, 'ISO 8.15.1.4, XLOG 2') :-
\+ \+( (Z = !, a(X), Z, c(X)) ).
runner_case(\+, 1, control, logical, 'ISO 8.15.1.4, ISO 5') :-
catch((\+ 3), error(E, _), true),
nonvar(E), E = type_error(callable, _).
/* once(A) */
runner_pred(once, 1, control, logical, 'ISO 8.15.2.4').
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, ISO 1') :-
once(!).
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, ISO 2a') :-
once(!), (X=1; X=2), X==1.
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, ISO 2b') :-
findall(X, (once(!), (X=1; X=2)), [_,X|_]), X==2.
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, ISO 2c') :-
findall(X, (once(!), (X=1; X=2)), [_,_]).
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, ISO 3') :-
once(repeat).
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, ISO 4') :-
\+ once(fail).
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, XLOG 1') :-
\+( (Z = !, once( (Z = !, a(X), Z, c(X)) )) ).
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, XLOG 2') :-
once( (Z = !, a(X), Z, c(X)) ).
runner_case(once, 1, control, logical, 'ISO 8.15.2.4, XLOG 3') :-
catch(once(_), error(E, _), true),
E == instantiation_error.
/* repeat */
runner_pred(repeat, 0, control, logical, 'ISO 8.15.3.4').
runner_case(repeat, 0, control, logical, 'ISO 8.15.3.4, ISO 2') :-
\+ (repeat, !, fail).
/****************************************************************/
/* Meta Predicates */
/****************************************************************/
/* call(A) */
runner_pred(call, 1, control, logical, 'ISO 7.8.3.4, Corr.2 7.8.3.4').
:- dynamic hit/0.
b(X) :- Y=(assertz(hit), X), call(Y).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 1') :-
call(!).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 2') :-
\+ call(fail).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 3') :-
\+ call((fail, _)).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 4') :-
\+ call((fail, call(1))).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 5a') :-
catch(b(_), error(_, _), true), retract(hit).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 5b') :-
catch(b(_), error(E, _), true), retract(hit),
E == instantiation_error.
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 6a') :-
catch(b(3), error(_, _), true), \+ retract(hit).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 6b') :-
catch(b(3), error(E, _), true), \+ retract(hit),
nonvar(E), E = type_error(callable, _).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 7a') :-
Z=!, call((Z=!, a(X), Z)), X == 1, Z == !.
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 7b') :-
findall(Z-X,(Z=!, call((Z=!, a(X), Z))),[_]).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 8a') :-
call((Z=!, a(X), Z)), X == 1, Z == !.
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 8b') :-
findall(Z-X,call((Z=!, a(X), Z)),[_,Z-X|_]), X == 2, Z == !.
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 8c') :-
findall(Z-X,call((Z=!, a(X), Z)),[_,_]).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 9a') :-
catch(call((assertz(hit), _)), error(_, _), true), retract(hit).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 9b') :-
catch(call((assertz(hit), _)), error(E, _), true), retract(hit),
E == instantiation_error.
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 10a') :-
catch(call((assertz(hit), call(2))), error(_, _), true), retract(hit).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 10b') :-
catch(call((assertz(hit), call(2))), error(E, _), true), retract(hit),
E == type_error(callable, 2).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 11') :-
catch(call(_), error(E, _), true),
E == instantiation_error.
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 12') :-
catch(call(4), error(E, _), true),
E == type_error(callable, 4).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 13') :-
catch(call((fail, 5)), error(E, _), true),
E == type_error(callable, 5).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 14a') :-
catch(call((assertz(hit), 6)), error(_, _), true), \+ retract(hit).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 14b') :-
catch(call((assertz(hit), 6)), error(E, _), true), \+ retract(hit),
E == type_error(callable, 6).
runner_case(call, 1, control, logical, 'ISO 7.8.3.4, ISO 15') :-
catch(call((7; true)), error(E, _), true),
E == type_error(callable, 7).