3
5
6
10
11test_suites([test_true, test_fail, test_cut, test_conj, test_disj,
12 test_ifthen, test_ifthenelse]).
13
14
19
20test_true_1 :- true.
21
22
27
28test_fail_1 :- fail.
29
30
35
36db_cut_twice(!) :- write('C ').
37db_cut_twice(true) :- write('Moss ').
38
39test_cut_1 :- !.
40test_cut_2 :- (!, fail ; true).
41test_cut_3 :- (call(!), fail ; true).
42test_cut_4 :- db_cut_twice(_), !, write('Forwards '), fail.
43test_cut_5 :- (! ; write('No ')), write('Cut disjunction '), fail.
44test_cut_6 :- db_cut_twice(_), (write('No ') ; !), write('Cut '), fail.
45test_cut_7 :- db_cut_twice(_), (!, fail ; write('No ')).
46test_cut_8(X) :- db_cut_twice(X), X, write('Forwards '), fail.
47test_cut_9 :- db_cut_twice(_), not(not(!)), write('Forwards '), fail.
48test_cut_10 :- db_cut_twice(_), once(!), write('Forwards '), fail.
49test_cut_11 :- db_cut_twice(_), call(!), write('Forwards '), fail.
50
58
59
64
65test_conj_1(X) :- ','(X = 1, var(X)).
66test_conj_2(X) :- ','(var(X), X = 1).
67test_conj_3(X) :- ','(X = true, call(X)).
68
69test_conj_1b(X) :- X = 1, var(X).
70test_conj_2b(X) :- var(X), X = 1.
71test_conj_3b(X) :- X = true, call(X).
72
73
78
79test_disj_1 :- ';'(true, fail).
80test_disj_2 :- ';'((!, fail), true).
81test_disj_3 :- ';'(!, call(3)).
82test_disj_4(X) :- ';'((X = 1, !), X = 2).
83
84test_disj_1b :- true ; fail.
85test_disj_2b :- (!, fail) ; true.
86test_disj_3b :- ! ; call(3).
87test_disj_4b(X) :- (X = 1, !) ; X = 2.
88
89
94
95test_ifthen_1 :- '->'(true, true).
96test_ifthen_2 :- '->'(true, fail).
97test_ifthen_3 :- '->'(fail, true).
98test_ifthen_4(X) :- '->'(true, X = 1).
99test_ifthen_5(X) :- '->'(';'(X = 1, X = 2), true).
100test_ifthen_6(X) :- '->'(true, ';'(X = 1, X = 2)).
101
102test_ifthen_1b :- true -> true.
103test_ifthen_2b :- true -> fail.
104test_ifthen_3b :- fail -> true.
105test_ifthen_4b(X) :- true -> X = 1.
106test_ifthen_5b(X) :- (X = 1 ; X = 2) -> true.
107test_ifthen_6b(X) :- true -> (X = 1 ; X = 2).
108
109
114
115test_ifthenelse_1 :- ';'('->'(true, true), fail).
116test_ifthenelse_2 :- ';'('->'(fail, true), true).
117test_ifthenelse_3 :- ';'('->'(true, fail), fail).
118test_ifthenelse_4 :- ';'('->'(fail, true), fail).
119test_ifthenelse_5(X) :- ';'('->'(true, X = 1), X = 2).
120test_ifthenelse_6(X) :- ';'('->'(fail, X = 1), X = 2).
121test_ifthenelse_7(X) :- ';'('->'(';'(X = 1, X = 2), true), true).
122
123test_ifthenelse_1b :- true -> true ; fail.
124test_ifthenelse_2b :- fail -> true ; true.
125test_ifthenelse_3b :- true -> fail ; fail.
126test_ifthenelse_4b :- fail -> true ; fail.
127test_ifthenelse_5b(X) :- true -> X = 1 ; X = 2.
128test_ifthenelse_6b(X) :- fail -> X = 1 ; X = 2.
129test_ifthenelse_7b(X) :- (X = 1 ; X = 2) -> true ; true