1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% Tests for predicates which find all solutions to a goal
    3
    4%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    5
    6
    7%
    8% List of test suites
    9%
   10
   11test_suites([test_findall, test_bagof, test_setof]).
   12
   13
   14%
   15% findall/3 test
   16% - ISO -
   17%
   18
   19test_findall_1(X, S) :- findall(X, (X = 1 ; X = 2), S).
   20test_findall_2(X, Y, S) :- findall(X + Y, (X = 1), S).
   21test_findall_3(X, L) :- findall(X, fail, L).
   22test_findall_4(X, S) :- findall(X, (X = 1 ; X = 1), S).
   23test_findall_5(X) :- findall(X, (X = 2 ; X = 1), [1, 2]).
   24test_findall_6(X, Goal, S) :- findall(X, Goal, S).
   25test_findall_7(X, S) :- findall(X, 4, S).
   26
   27throws_exception(test_findall_6).
   28throws_exception(test_findall_7).
   29
   30
   31%
   32% bagof/3 test
   33% - ISO -
   34%
   35
   36db_bagof_a(1, f(_)).
   37db_bagof_a(2, f(_)).
   38
   39db_bagof_b(1, 1).
   40db_bagof_b(1, 1).
   41db_bagof_b(1, 2).
   42db_bagof_b(2, 1).
   43db_bagof_b(2, 2).
   44db_bagof_b(2, 2).
   45
   46test_bagof_1(X, S) :- bagof(X, (X = 1 ; X = 2), S).
   47test_bagof_2(X) :- bagof(X, (X = 1 ; X = 2), X).
   48test_bagof_3(X, S) :- bagof(X, fail, S).
   49test_bagof_4(Y, L) :- bagof(1, (Y = 1 ; Y = 2), L).
   50test_bagof_5(X, Y, L) :- bagof(f(X, Y), (X = a ; Y = b), L).
   51test_bagof_6(X, Y, S) :- bagof(X, Y ^ ((X = 1, Y = 1) ; (X = 2, Y = 2)), S).
   52test_bagof_7(X, Y, S) :- bagof(X, Y ^ ((X = 1 ; Y = 1) ; (X = 2 ; Y = 2)), S).
   53test_bagof_8(X, Y, Z, S) :- bagof(X, (X = Y ; X = Z ; Y = 1), S).
   54test_bagof_9(X, Y, Z, S) :- bagof(X, (X = Y ; X = Z), S).
   55test_bagof_10(X, Y, L) :- bagof(X, db_bagof_a(X, Y), L).
   56test_bagof_11(X, Y, L) :- bagof(X, db_bagof_b(X, Y), L).
   57test_bagof_12(X, Y, Z, L) :- bagof(X, Y ^ Z, L).
   58test_bagof_13(X, L) :- bagof(X, 1, L).
   59
   60throws_exception(test_bagof_12).
   61throws_exception(test_bagof_13).
   62
   63% The following test isn't included because it may succeed or throw an
   64% exception depending on the 'unknown' (SWI-Prolog) or 'undefined_predicate'
   65% (ISO) system flag
   66%
   67%test_bagof_X1(X, Y, S) :- bagof(X, (Y ^ (X = 1 ; Y = 2) ; X = 3), S).
   68
   69
   70%
   71% setof/3 test
   72% - ISO -
   73%
   74
   75db_setof_a(1, f(_)).
   76db_setof_a(2, f(_)).
   77
   78db_setof_b(1, 1).
   79db_setof_b(1, 1).
   80db_setof_b(1, 2).
   81db_setof_b(2, 1).
   82db_setof_b(2, 2).
   83db_setof_b(2, 2).
   84
   85db_setof_d(1, 1).
   86db_setof_d(1, 2).
   87db_setof_d(1, 1).
   88db_setof_d(2, 2).
   89db_setof_d(2, 1).
   90db_setof_d(2, 2).
   91
   92test_setof_1(X, S) :- setof(X, (X = 1 ; X = 2), S).
   93test_setof_2(X) :- setof(X, (X = 1 ; X = 2), X).
   94test_setof_3(X, S) :- setof(X, (X = 2 ; X = 1), S).
   95test_setof_4(X, S) :- setof(X, (X = 2 ; X = 2), S).
   96test_setof_5(X, Y, Z, S) :- setof(X, (X = Y ; X = Z), S).
   97test_setof_6(X, S) :- setof(X, fail, S).
   98test_setof_7(Y, L) :- setof(1, (Y = 2 ; Y = 1), L).
   99test_setof_8(X, Y, L) :- setof(f(X, Y), (X = a ; Y = b), L).
  100test_setof_9(X, Y, S) :- setof(X, Y ^ ((X = 1, Y = 1) ; (X = 2, Y = 2)), S).
  101test_setof_10(X, Y, S) :- setof(X, Y ^ ((X = 1 ; Y = 1) ; (X = 2 ; Y = 2)), S).
  102test_setof_11(X, Z, S) :- setof(X, (X = Y ; X = Z; Y = 1), S).
  103test_setof_12(X, Y, L) :- setof(X, db_setof_a(X, Y), L).
  104test_setof_13(X, U, V, L) :- setof(X, member(X, [f(U, b), f(V, c)]), L).
  105test_setof_14(X, U, V) :- setof(X, member(X, [f(U, b), f(V, c)]),
  106                                [f(a, c), f(a, b)]). % Implementation dependent
  107test_setof_15(X, U, V) :- setof(X, member(X, [f(b, U), f(c, V)]), [f(b, a), f(c, a)]).
  108test_setof_16(X, V, U, L) :- setof(X, member(X, [V, U, f(U), f(V)]), L).
  109test_setof_17(X, V, U) :- setof(X, member(X, [V, U, f(U), f(V)]),
  110                                [a, b, f(a), f(b)]). % Implementation dependent
  111test_setof_18(X, V, U) :- setof(X, member(X, [V, U, f(U), f(V)]), [a, b, f(b), f(a)]).
  112test_setof_19(X, U, V) :- setof(X, (exists(U, V) ^ member(X, [V, U, f(U), f(V)])),
  113                                [a, b, f(b), f(a)]).
  114test_setof_20(X, Y, L) :- setof(X, db_setof_b(X, Y), L).
  115test_setof_21(X, Xs, Y, L) :- setof(X-Xs, Y ^ setof(Y, db_setof_b(X, Y), Xs), L).
  116test_setof_22(X, Xs, Y, L) :- setof(X-Xs, setof(Y, db_setof_b(X, Y), Xs), L).
  117test_setof_23(X, Xs, Y, L) :- setof(X-Xs, bagof(Y, db_setof_d(X, Y), Xs), L).
  118
  119% The following test isn't included because it may succeed or throw an
  120% exception depending on the 'unknown' (SWI-Prolog) or 'undefined_predicate'
  121% (ISO) system flag
  122%
  123%test_setof_X1(X, Y, S) :- setof(X, (Y ^ (X = 1 ; Y = 2) ; X = 3), S).