Site Map
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 is the following standard:
* - Prolog General Core ISO/IEC 13211-1
* - Draft Technical Corrigendum 3, WG17, Ulrich Neumerkel
* <a href="https://www.complang.tuwien.ac.at/ulrich/iso-prolog/WDCor3">https://www.complang.tuwien.ac.at/ulrich/iso-prolog/WDCor3</a>
*/
runner_file(stream, read, 'ISO 8.14 serial').
:- op(1105, xfy, '|').
/****************************************************************/
/* Term Input / Output */
/****************************************************************/
/* op(L, M, O) */
runner_pred(op,3, stream, read, 'ISO 8.14.3.4, Corr.2 8.14.3.4').
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 1') :-
op(30, xfy, ++), current_op(30, xfy, ++).
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 2') :-
op(0, yfx, ++), \+ current_op(30, xfy, ++).
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 3') :-
catch(op(max, xfy, ++), error(E, _), true),
E == type_error(integer, max).
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 4') :-
catch(op(-30, xfy, ++), error(E, _), true),
E == domain_error(not_less_than_zero, -30).
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 5') :-
catch(op(1201, xfy, ++), error(E, _), true),
E == domain_error(operator_priority, 1201).
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 6') :-
catch(op(30, _, ++), error(E, _), true),
E == instantiation_error.
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 7') :-
catch(op(30, yfy, ++), error(E, _), true),
E == domain_error(operator_specifier, yfy).
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 8') :-
catch(op(30, xfy, 0), error(E, _), true),
nonvar(E), E = type_error(_, 0).
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 9') :-
op(30, xfy, ++), op(40, xfx, ++), current_op(40, xfx, ++), op(0, xfx, ++).
runner_case(op,3, stream, read, 'ISO 8.14.3.4, ISO 10') :-
op(30, xfy, ++), catch(op(50, yf, ++), error(E,_), true),
E == permission_error(create, operator, ++).
/* write(X) */
runner_pred(write,1, stream, read, 'ISO 8.14.2.5').
runner_case(write,1, stream, read, 'ISO 8.14.2.5, ISO 4') :-
open_output_atom_stream(S),
write(S, '1<2'),
close_output_atom_stream(S, X),
X == '1<2'.
runner_case(write,1, stream, read, 'ISO 6.3.4.3, XLOG 1') :-
op(9,fy,fy), op(9,yf,yf),
open_output_atom_stream(S),
write(S, yf(fy(1))),
close_output_atom_stream(S, X),
X == '(fy 1)yf'.
runner_case(write,1, stream, read, 'ISO 6.3.4.3, XLOG 2') :-
op(9,fy,fy), op(9,yfx,yfx),
open_output_atom_stream(S),
write(S, yfx(fy(1),2)),
close_output_atom_stream(S, X),
X == '(fy 1)yfx 2'.
runner_case(write,1, stream, read, 'ISO 6.3.4.3, XLOG 3') :-
op(9,fy,fy), op(9,xfy,xfy),
open_output_atom_stream(S),
write(S, fy(xfy(1,2))),
close_output_atom_stream(S, X),
X == 'fy 1 xfy 2'.
runner_case(write,1, stream, read, 'ISO 6.4.1, XLOG 4') :-
open_output_atom_stream(S),
write(S, '//*'),
close_output_atom_stream(S, X),
X == '//*' .
runner_case(write,1, stream, read, 'ISO 6.4.1, XLOG 5') :-
open_output_atom_stream(S),
write(S, - '123n'),
close_output_atom_stream(S, X),
X == '- 123n'.
/* writeq(X) */
runner_pred(writeq,1, stream, read, 'ISO 8.14.2.5').
runner_case(writeq,1, stream, read, 'ISO 8.14.2.5, ISO 4') :-
open_output_atom_stream(S),
writeq(S, '1<2'),
close_output_atom_stream(S, X),
X == '\'1<2\''.
runner_case(writeq,1, stream, read, 'ISO 6.4.1, XLOG 1') :-
open_output_atom_stream(S),
writeq(S, '//*'),
close_output_atom_stream(S, X),
X == '//*' .
runner_case(writeq,1, stream, read, 'ISO 6.4.1, XLOG 2') :-
open_output_atom_stream(S),
writeq(S, f('$VAR'(1), '$VAR'(0), '$VAR'(1))),
close_output_atom_stream(S, X),
X == 'f(B, A, B)'.
runner_case(writeq,1, stream, read, 'ISO 6.4.1, XLOG 3') :-
open_output_atom_stream(S),
current_output(Y), writeq(S, - Y),
close_output_atom_stream(S, X),
X == '- 0rReference'.
/* write_canonical(X) */
runner_pred(write_canonical,1, stream, read, 'ISO 8.14.2.5').
runner_case(write_canonical,1, stream, read, 'ISO 8.14.2.5, ISO 2') :-
open_output_atom_stream(S),
write_canonical(S, [1,2,3]),
close_output_atom_stream(S, X),
X == '\'.\'(1, \'.\'(2, \'.\'(3, [])))'.
runner_case(write_canonical,1, stream, read, 'ISO 8.14.2.5, XLOG 1') :-
open_output_atom_stream(S),
write_canonical(S, (a,b)),
close_output_atom_stream(S, X),
X == '\',\'(a, b)'.
runner_case(write_canonical,1, stream, read, 'ISO 8.14.2.5, XLOG 2') :-
open_output_atom_stream(S),
write_canonical(S, 1<2),
close_output_atom_stream(S, X),
X == '<(1, 2)'.
runner_case(write_canonical,1, stream, read, 'ISO 8.14.2.5, XLOG 3') :-
open_output_atom_stream(S),
write_canonical(S, f('$VAR'(1), '$VAR'(0), '$VAR'(1))),
close_output_atom_stream(S, X),
X == 'f(\'$VAR\'(1), \'$VAR\'(0), \'$VAR\'(1))'.
/* write_term(X,L) */
runner_pred(write_term,2, stream, read, 'ISO 8.14.2.4').
runner_case(write_term,2, stream, read, 'ISO 8.14.2.4, ISO 1') :-
open_output_atom_stream(S),
write_term(S, [1,2,3],[]),
close_output_atom_stream(S, X),
X == '[1, 2, 3]'.
runner_case(write_term,2, stream, read, 'ISO 8.14.2.4, ISO 3') :-
open_output_atom_stream(S),
write_term(S, '1<2',[]),
close_output_atom_stream(S, X),
X == '1<2'.
runner_case(write_term,2, stream, read, 'ISO 8.14.2.4, XLOG 1') :-
open_output_atom_stream(S),
write_term(S, f(',',a),[quoted(true)]),
close_output_atom_stream(S, X),
X == 'f(\',\', a)'.
runner_case(write_term,2, stream, read, 'ISO 8.14.2.4, XLOG 2') :-
open_output_atom_stream(S),
write_term(S, ((a ; b) | c),[quoted(true)]),
close_output_atom_stream(S, X),
X == 'a; b | c'.
/* read(X) */
runner_pred(read,1, stream, read, 'ISO 8.14.1.4, ISO 6.3.3.1').
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 1a') :-
open_input_atom_stream('term1. term2. ', S),
findall(X, (read(S, X); read(S, X)), [Y|_]),
Y == term1.
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 1b') :-
open_input_atom_stream('term1. term2. ', S),
findall(X, (read(S, X); read(S, X)), [_,Y|_]),
Y == term2.
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 1c') :-
open_input_atom_stream('term1. term2. ', S),
findall(X, (read(S, X); read(S, X)), [_,_]).
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 4') :-
open_input_atom_stream('3.1. term2. ', S),
\+ read(S, 4.1).
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 5') :-
open_input_atom_stream('foo 123. term2. ', S),
catch(read(S, _), error(E, _), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 6') :-
open_input_atom_stream('3.1 ', S),
catch(read(S, _), error(E, _), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 8.14.1.4, XLOG 1') :-
open_input_atom_stream('3.1 ', S),
(catch(read(S, _), error(_,_), fail); read(S, end_of_file)).
runner_case(read,1, stream, read, 'ISO 6.3.3.1, XLOG 1') :-
open_input_atom_stream('[a,b|,].', S),
catch(read(S, _), error(E,_), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 6.3.3.1, XLOG 2') :-
open_input_atom_stream('{,}.', S),
catch(read(S, _), error(E,_), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 6.3.3.1, XLOG 3') :-
open_input_atom_stream('\'\\N\'.', S),
catch(read(S, _), error(E,_), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 6.3.3.1, XLOG 4') :-
open_input_atom_stream('X = |.', S),
catch(read(S, _), error(E,_), true),
nonvar(E), E = syntax_error(_).
runner_case(read,2, stream, read, 'ISO 8.14.1.4, ISO 2c') :-
open_input_atom_stream('foo(A+Roger,A+_). term2. ', S),
read(S, X),
X = foo(X1+X2,X3+X4),
var(X1), var(X2), var(X3), var(X4).
runner_case(read,2, stream, read, 'ISO 8.14.1.4, ISO 2d') :-
open_input_atom_stream('foo(A+Roger,A+_). term2. ', S),
read(S, X),
X = foo(X1+X2,X3+X4),
X1 \== X2, X1 \== X4, X2 \== X4, X1 == X3.
/* read_term(X,L) */
runner_pred(read_term,2, stream, read, 'ISO 8.14.1.4').
runner_case(read_term,2, stream, read, 'ISO 8.14.1.4, ISO 1') :-
open_input_atom_stream('term1. term2. ', S),
findall(X, (read_term(S, X, [variable_names(_),
singletons(_)]); read(S, X)),[_,Y|_]),
Y == term2.
runner_case(read_term,2, stream, read, 'ISO 8.14.1.4, ISO 2a') :-
open_input_atom_stream('foo(A+Roger,A+_). term2. ', S),
read_term(S, _, [variable_names(VN), singletons(VS)]),
VN = ['A' = X1, 'Roger' = X2],
VS = ['Roger' = X3],
var(X1), var(X2), var(X3).
runner_case(read_term,2, stream, read, 'ISO 8.14.1.4, ISO 2b') :-
open_input_atom_stream('foo(A+Roger,A+_). term2. ', S),
read_term(S, _, [variable_names(VN), singletons(VS)]),
VN = ['A' = X1, 'Roger' = X2],
VS = ['Roger' = X3],
X1 \== X2, X2 == X3.
runner_case(read_term,2, stream, read, 'ISO 6.3.4.3, XLOG 3') :-
op(9,fy,fy), op(9,yf,yf),
open_input_atom_stream('fy 1 yf.', S),
read_term(S, X, []),
X == fy(yf(1)).
runner_case(read_term,2, stream, read, 'ISO 6.3.4.3, XLOG 4') :-
op(9,fy,fy), op(9,yfx,yfx),
open_input_atom_stream('fy 1 yfx 2.', S),
read_term(S, X, []),
X == fy(yfx(1,2)).
runner_case(read_term,2, stream, read, 'ISO 6.3.4.3, XLOG 5') :-
op(9,yf,yf), op(9,xfy,xfy),
open_input_atom_stream('1 xfy 2 yf.', S),
read_term(S, X, []),
X == xfy(1,yf(2)).
/* variable_names(N) write option */
runner_pred(variable_names, 1, stream, read, 'Corr 3, 7.10.4').
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 1') :-
open_output_atom_stream(S),
write_term(S, foo(A+Roger,A+H),
[variable_names(['A'=A,'Roger'=Roger,'_'=H])]),
close_output_atom_stream(S, X),
X == 'foo(A+Roger, A+_)'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 2') :-
open_output_atom_stream(S),
A = Roger, write_term(S, foo(A+Roger,A+H),
[variable_names(['A'=A,'Roger'=Roger,'_'=H])]),
close_output_atom_stream(S, X),
X == 'foo(A+A, A+_)'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 3') :-
open_output_atom_stream(S),
A = foo, write_term(S, foo(A+Roger,A+H),
[variable_names(['A'=A,'Roger'=Roger,'_'=H])]),
close_output_atom_stream(S, X),
X == 'foo(foo+Roger, foo+_)'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 4') :-
open_output_atom_stream(S),
write_term(S, T, [variable_names(['))'=T])]),
close_output_atom_stream(S, X),
X == '))'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 5') :-
open_output_atom_stream(S),
write_term(S, - X, [variable_names(['9'=X])]),
close_output_atom_stream(S, X),
X == '- 9'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 6') :-
open_output_atom_stream(S),
write_term(S, T, [variable_names(['x+y'=T]), quoted(true)]),
close_output_atom_stream(S, X),
X == '`x+y`'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 7') :-
open_output_atom_stream(S),
write_term(S, T, [variable_names(['_/*.*/'=T]), quoted(true)]),
close_output_atom_stream(S, X),
X == '`_/*.*/`'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, ISO 1') :-
open_output_atom_stream(S),
catch(write_term(S, T, [variable_names([_=T])]), error(E,_), true),
E == instantiation_error.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, ISO 8') :-
open_output_atom_stream(S),
catch(write_term(S, T, [variable_names([1+2=T])]), error(E,_), true),
E == type_error(atom,1+2).
/* open(P, M, S), ISO 8.11.5.4 */
runner_pred(open,3, stream, read, 'ISO 8.11.5.4').
runner_case(open,3, stream, read, 'ISO 8.11.5.4, XLOG 1') :-
current_prolog_flag(argv, [_,_,Key|_]),
atom_join(['data',Key,'.txt'], OutName),
open(OutName, write, D),
catch(put_code(D, 0xE54), _, (close(D), fail)),
close(D).
runner_case(open,3, stream, read, 'ISO 8.11.5.4, XLOG 2') :-
current_prolog_flag(argv, [_,_,Key|_]),
atom_join(['data',Key,'.txt'], InName),
open(InName, read, D),
get_code(D, C),
close(D),
delete_file(InName),
C == 0xE54.
runner_case(open,3, stream, read, 'ISO 8.11.5.4, XLOG 3') :-
catch(open('stream', read, _), error(E, _), true),
E == existence_error(source_sink, 'stream').
runner_case(open,3, stream, read, 'ISO 8.11.5.4, XLOG 4') :-
catch(open('stream', write, _), error(E, _), true),
E == existence_error(source_sink, 'stream').