3
5
6
10
11test_suites([test_call, test_failif, test_not, test_once, test_ignore,
12 test_timepred, test_maplist, test_apply, test_forall]).
13
14
19
20db_call_b(X) :-
21 Y = (write(X), call(X)), 22 call(Y).
23
24db_call_a(1).
25db_call_a(2).
26
27test_call_1 :- call(!).
28test_call_2 :- call(fail).
29test_call_3(X) :- call((fail, call(X))). 30test_call_4 :- call((fail, call(1))).
31test_call_5 :- db_call_b(3).
32test_call_6(Z, X) :- (Z = !, call((Z = !, db_call_a(X), Z))).
33test_call_7(Z ,X) :- call((Z = !, db_call_a(X), Z)).
34test_call_8(X) :- call((write(3), X)).
35test_call_9 :- call((write(3), call(1))).
36test_call_10(X) :- call(X).
37test_call_11 :- call(1).
38test_call_12 :- call((fail, 1)).
39test_call_13 :- call((write(3), 1)).
40test_call_14 :- call((1 ; true)).
41
42throws_exception(test_call_5).
43throws_exception(test_call_8).
44throws_exception(test_call_9).
45throws_exception(test_call_10).
46throws_exception(test_call_11).
47throws_exception(test_call_12).
48throws_exception(test_call_13).
49throws_exception(test_call_14).
50
54
55
60
61test_failif_1 :- \+(true).
62test_failif_2 :- \+(!).
63test_failif_3 :- \+((!, fail)).
64test_failif_4(X) :- (X = 1 ; X = 2), \+((!, fail)).
65test_failif_5 :- \+(4 = 5).
67test_failif_7(X) :- \+(X).
68test_failif_8(X) :- \+(X = f(X)). 69
70throws_exception(test_failif_6).
71throws_exception(test_failif_7).
72
73
78
79test_not_1 :- not(true).
80test_not_2 :- not(!).
81test_not_3 :- not((!, fail)).
82test_not_4(X) :- (X = 1 ; X = 2), not((!, fail)).
83test_not_5 :- not(4 = 5).
84test_not_6 :- not(3).
85test_not_7(X) :- not(X).
86test_not_8(X) :- not(X = f(X)). 87
88throws_exception(test_not_6).
89throws_exception(test_not_7).
90
91
96
97test_once_1 :- once(!).
98test_once_2(X) :- once(!), (X = 1; X = 2).
99test_once_3 :- once(repeat).
100test_once_4 :- once(fail).
101test_once_5(X) :- once(X = f(X)). 102
103
108
109test_ignore_1 :- once(!).
110test_ignore_2(X) :- once(!), (X = 1; X = 2).
111test_ignore_3 :- once(repeat).
112test_ignore_4 :- once(fail).
113test_ignore_5(X) :- once(X = f(X)).
114
115
120
121test_timepred_1 :- time(!).
122test_timepred_2 :- time(write(foo)).
123test_timepred_3 :- time(time((write(foo), write(foo)))).
124
125
130
131db_maplist_sample(a).
132db_maplist_sample(b).
133db_maplist_sample(c).
134
135test_maplist_1 :- maplist(write, [a, b, c]).
136test_maplist_2 :- maplist(write, [a, b, c, d, e, f]).
137test_maplist_3 :- maplist(db_maplist_sample, [a, b, c]).
138test_maplist_4 :- maplist(db_maplist_sample, [a, b, c, d, e, f]).
139test_maplist_5 :- maplist(_, [a, b]).
140
141throws_exception(test_maplist_5).
142
143
148
149db_apply_numbers(1, 5).
150db_apply_numbers(5, 1).
151db_apply_numbers(0, 0).
152db_apply_true.
153
154test_apply_1 :- apply(write, [foo]).
155test_apply_2 :- apply(<, [5, 9]).
156test_apply_3 :- apply(db_apply_true, []).
157test_apply_4(X, Y) :- apply(db_apply_numbers, [X, Y]), X =:= Y.
158test_apply_5(X) :- apply(X, [foo]).
159test_apply_6 :- apply(db_apply_true, _).
160
161throws_exception(test_apply_5).
162throws_exception(test_apply_6).
163
164
169
170db_forall_object(table).
171db_forall_object(chair).
172db_forall_object(lamp).
173
174test_forall_1 :- forall(true, write(foo)).
175test_forall_2 :- forall(fail, write(foo)).
176test_forall_3 :- forall(X is 5 + 9, write(X)).
177test_forall_4 :- forall(member(X, [a, b, c]), write(X)).
178test_forall_5 :- forall(member(X, [a, b, c]), (X == a ; write(X))).
179test_forall_6 :- forall(member(X, [5, 10, -6]), X > 2).
180test_forall_7(L) :- setof(X, db_forall_object(X), L),
181 forall(member(Y, L), call(db_forall_object(Y))).
182test_forall_8 :- forall(_, true).
183test_forall_9 :- forall(true, _).
184
185throws_exception(test_forall_8).
186throws_exception(test_forall_9)