Heimseite
Seitenübersicht
An/abmeldung
Anschlagbrett
Herunterladen(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') :-
with_text_to(X, write('1<2')),
X == '1<2'.
runner_case(write,1, stream, read, 'ISO 6.3.4.3, XLOG 1') :-
op(9,fy,fy), op(9,yf,yf),
with_text_to(X, write(yf(fy(1)))),
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),
with_text_to(X, write(yfx(fy(1),2))),
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),
with_text_to(X, write(fy(xfy(1,2)))),
X == 'fy 1 xfy 2'.
runner_case(write,1, stream, read, 'ISO 6.4.1, XLOG 4') :-
with_text_to(X, write('//*')),
X == '//*' .
runner_case(write,1, stream, read, 'ISO 6.4.1, XLOG 5') :-
with_text_to(X, write(- '123n')),
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') :-
with_text_to(X, writeq('1<2')),
X == '\'1<2\''.
runner_case(writeq,1, stream, read, 'ISO 6.4.1, XLOG 1') :-
with_text_to(X, writeq('//*')),
X == '//*' .
runner_case(writeq,1, stream, read, 'ISO 6.4.1, XLOG 2') :-
with_text_to(X, writeq(f('$VAR'(1), '$VAR'(0), '$VAR'(1)))),
X == 'f(B, A, B)'.
runner_case(writeq,1, stream, read, 'ISO 6.4.1, XLOG 3') :-
current_output(Y), with_text_to(X, writeq(- Y)),
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') :-
with_text_to(X, write_canonical([1,2,3])),
X == '\'.\'(1, \'.\'(2, \'.\'(3, [])))'.
runner_case(write_canonical,1, stream, read, 'ISO 8.14.2.5, XLOG 1') :-
with_text_to(X, write_canonical((a,b))),
X == '\',\'(a, b)'.
runner_case(write_canonical,1, stream, read, 'ISO 8.14.2.5, XLOG 2') :-
with_text_to(X, write_canonical(1<2)),
X == '<(1, 2)'.
runner_case(write_canonical,1, stream, read, 'ISO 8.14.2.5, XLOG 3') :-
with_text_to(X, write_canonical(f('$VAR'(1), '$VAR'(0), '$VAR'(1)))),
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') :-
with_text_to(X, write_term([1,2,3],[])),
X == '[1, 2, 3]'.
runner_case(write_term,2, stream, read, 'ISO 8.14.2.4, ISO 3') :-
with_text_to(X, write_term('1<2',[])),
X == '1<2'.
runner_case(write_term,2, stream, read, 'ISO 8.14.2.4, XLOG 1') :-
with_text_to(X, write_term(f(',',a),[quoted(true)])),
X == 'f(\',\', a)'.
runner_case(write_term,2, stream, read, 'ISO 8.14.2.4, XLOG 2') :-
with_text_to(X, write_term(((a ; b) | c),[quoted(true)])),
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') :-
findall(X, with_text_from('term1. term2. ', (read(X); read(X))),[Y|_]), Y==term1.
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 1b') :-
findall(X, with_text_from('term1. term2. ', (read(X); read(X))),[_,Y]), Y==term2.
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 1c') :-
findall(X, with_text_from('term1. term2. ', (read(X); read(X))),[_,_]).
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 4') :-
\+ with_text_from('3.1. term2. ', read(4.1)).
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 5') :-
catch(with_text_from('foo 123. term2. ', read(_)), error(E, _), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 8.14.1.4, ISO 6') :-
catch(with_text_from('3.1 ', read(_)), error(E, _), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 8.14.1.4, XLOG 1') :-
with_text_from('3.1 ', (catch(read(_),error(_,_),fail); read(end_of_file))).
runner_case(read,1, stream, read, 'ISO 6.3.3.1, XLOG 1') :-
catch(with_text_from('[a,b|,].', read(_)), error(E,_), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 6.3.3.1, XLOG 2') :-
catch(with_text_from('{,}.', read(_)), error(E,_), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 6.3.3.1, XLOG 3') :-
catch(with_text_from('\'\\N\'.', read(_)), error(E,_), true),
nonvar(E), E = syntax_error(_).
runner_case(read,1, stream, read, 'ISO 6.3.3.1, XLOG 4') :-
catch(with_text_from('X = |.', read(_)), error(E,_), true),
nonvar(E), E = syntax_error(_).
runner_case(read,2, stream, read, 'ISO 8.14.1.4, ISO 2c') :-
with_text_from('foo(A+Roger,A+_). term2. ', read(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') :-
with_text_from('foo(A+Roger,A+_). term2. ', read(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') :-
findall(X, with_text_from('term1. term2. ', (read_term(X,
[variable_names(_), singletons(_)]); read(X))),[_,Y|_]),
Y == term2.
runner_case(read_term,2, stream, read, 'ISO 8.14.1.4, ISO 2a') :-
with_text_from('foo(A+Roger,A+_). term2. ', read_term(_,
[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') :-
with_text_from('foo(A+Roger,A+_). term2. ', read_term(_,
[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),
with_text_from('fy 1 yf.', read_term(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),
with_text_from('fy 1 yfx 2.', read_term(X,[])),
X == fy(yfx(1,2)).
runner_case(read_term,2, stream, read, 'ISO 6.3.4.3, XLOG 5') :-
op(9,fy,fy), op(9,xfy,xfy),
with_text_from('1 xfy 2 yf.', read_term(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') :-
with_text_to(R, write_term(foo(A+Roger,A+H),
[variable_names(['A'=A,'Roger'=Roger,'_'=H])])),
R == 'foo(A+Roger, A+_)'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 2') :-
A = Roger, with_text_to(R, write_term(foo(A+Roger,A+H),
[variable_names(['A'=A,'Roger'=Roger,'_'=H])])),
R == 'foo(A+A, A+_)'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 3') :-
A = foo, with_text_to(R, write_term(foo(A+Roger,A+H),
[variable_names(['A'=A,'Roger'=Roger,'_'=H])])),
R == 'foo(foo+Roger, foo+_)'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 4') :-
with_text_to(R, write_term(T, [variable_names(['))'=T])])),
R == '))'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 5') :-
with_text_to(R, write_term(- X, [variable_names(['9'=X])])),
R == '- 9'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 6') :-
with_text_to(R, write_term(T, [variable_names(['x+y'=T]), quoted(true)])),
R == '`x+y`'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, XLOG 7') :-
with_text_to(R, write_term(T, [variable_names(['_/*.*/'=T]), quoted(true)])),
R == '`_/*.*/`'.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, ISO 1') :-
catch(with_text_to(_, write_term(T, [variable_names([_=T])])), error(E,_), true),
E == instantiation_error.
runner_case(variable_names, 1, stream, read, 'Corr 3, 7.10.4, ISO 8') :-
catch(with_text_to(_, write_term(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') :-
open('data2.txt', write, D),
put_code(D, 0xE54),
close(D).
runner_case(open,3, stream, read, 'ISO 8.11.5.4, XLOG 2') :-
open('data2.txt', read, D),
get_code(D, C),
close(D),
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').