This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/Logtalk/examples/dcgs/dcgtest.lgt
pmoura 9fe4d26c59 Logtalk 2.27.0 files.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1539 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2006-02-10 17:44:05 +00:00

119 lines
3.9 KiB
Plaintext

:- object(dcgtest).
:- info([
version is 1.0,
date is 2004/9/27,
author is 'Paulo Moura',
comment is 'Test cases for the Logtalk DCG translator.']).
:- public(run/0).
:- mode(run, one).
:- info(run/0, [
comment is 'Runs the Logtalk DCG translator on the test cases.']).
run :-
write('Testing expand_term/2 predicate ...'), nl, nl,
gr_tr_test(N, GR, Result),
write(N), write(': '), writeq(GR), write(' --- '),
write(Result), write(' expected'), nl,
( catch(
expand_term(GR, Clause),
Error,
(write(' error: '), write(Error), nl, fail)) ->
write(' '), writeq(Clause)
; write(' expansion failed!')
),
nl, nl,
fail.
run.
write_error(Error) :-
write(' ERROR: '), writeq(Error), nl, fail.
% terminal tests with list notation:
gr_tr_test(101, (p --> []), success).
gr_tr_test(102, (p --> [b]), success).
gr_tr_test(103, (p --> [abc, xyz]), success).
gr_tr_test(104, (p --> [abc | xyz]), error).
gr_tr_test(105, (p --> [[], {}, 3, 3.2, a(b)]), success).
gr_tr_test(106, (p --> [_]), success).
% terminal tests with string notation:
gr_tr_test(151, (p --> "b"), success).
gr_tr_test(152, (p --> "abc", "q"), success).
gr_tr_test(153, (p --> "abc" ; "q"), success).
% simple non-terminal tests:
gr_tr_test(201, (p --> b), success).
gr_tr_test(202, (p --> 3), error).
gr_tr_test(203, (p(X) --> b(X)), success).
% conjunction tests:
gr_tr_test(301, (p --> b, c), success).
gr_tr_test(311, (p --> true, c), success).
gr_tr_test(312, (p --> fail, c), success).
gr_tr_test(313, (p(X) --> call(X), c), success).
% disjunction tests:
gr_tr_test(351, (p --> b ; c), success).
gr_tr_test(352, (p --> q ; []), success).
gr_tr_test(353, (p --> [a] ; [b]), success).
% if-then-else tests:
gr_tr_test(401, (p --> b -> c), success).
gr_tr_test(411, (p --> b -> c; d), success).
gr_tr_test(421, (p --> b -> c1, c2 ; d), success).
gr_tr_test(422, (p --> b -> c ; d1, d2), success).
gr_tr_test(431, (p --> b1, b2 -> c ; d), success).
gr_tr_test(441, (p --> [x] -> [] ; q), success).
% negation tests:
gr_tr_test(451, (p --> \+ b, c), success).
gr_tr_test(452, (p --> b, \+ c, d), success).
% cut tests:
gr_tr_test(501, (p --> !, [a]), success).
gr_tr_test(502, (p --> b, !, c, d), success).
gr_tr_test(503, (p --> b, !, c ; d), success).
gr_tr_test(504, (p --> [a], !, {fail}), success).
gr_tr_test(505, (p(a), [X] --> !, [X, a], q), success).
gr_tr_test(506, (p --> a, ! ; b), success).
% {}/1 tests:
gr_tr_test(601, (p --> {b}), success).
gr_tr_test(602, (p --> {3}), error).
gr_tr_test(603, (p --> {c,d}), success).
gr_tr_test(604, (p --> '{}'((c,d))), success).
gr_tr_test(605, (p --> {a}, {b}, {c}), success).
gr_tr_test(606, (p --> {q} -> [a] ; [b]), success).
gr_tr_test(607, (p --> {q} -> [] ; b), success).
gr_tr_test(608, (p --> [foo], {write(x)}, [bar]), success).
gr_tr_test(609, (p --> [foo], {write(hello)},{nl}), success).
gr_tr_test(610, (p --> [foo], {write(hello), nl}), success).
% "metacall" tests:
gr_tr_test(701, (p --> X), success).
gr_tr_test(702, (p --> _), success).
% non-terminals corresponding to "graphic" characters
% or built-in operators/predicates:
gr_tr_test(801, ('[' --> b, c), success).
gr_tr_test(802, ((=) --> b, c), success).
% pushback tests:
gr_tr_test(901, (p, [t] --> b, c), success).
gr_tr_test(902, (p, [t] --> b, [t]), success).
gr_tr_test(903, (p, [t] --> b, [s, t]), success).
gr_tr_test(904, (p, [t] --> b, [s], [t]), success).
gr_tr_test(905, (p(X), [X] --> [X]), success).
gr_tr_test(906, (p(X, Y), [X, Y] --> [X, Y]), success).
gr_tr_test(907, (p(a), [X] --> !, [X, a], q), success).
gr_tr_test(908, (p, [a,b] --> [foo], {write(hello), nl}), success).
gr_tr_test(909, (p, [t1], [t2] --> b, c), error).
gr_tr_test(910, (p, b --> b), error).
gr_tr_test(911, ([t], p --> b), error).
gr_tr_test(911, ([t1], p, [t2] --> b), error).
:- end_object.