1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% Tests for other higher-order predicates
    3
    4%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    5
    6
    7%
    8% List of test suites
    9%
   10
   11test_suites([test_call, test_failif, test_not, test_once, test_ignore,
   12             test_timepred, test_maplist, test_apply, test_forall]).
   13
   14
   15%
   16% call/1 test
   17% - ISO -
   18%
   19
   20db_call_b(X) :-
   21	Y = (write(X), call(X)),  % BPL needs 'call' in '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))). % BPL needs 'call' in '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
   51% This test works perfectly in Bousi-Prolog but it can't be checked because a
   52% different variable name is written when it's run on Prolog and Bousi-Prolog
   53%test_call_X1 :- db_call_b(_).
   54
   55
   56%
   57% \+/1 test (called fail_if/1 in 2nd draft of ISO Prolog Standard)
   58% - ISO -
   59%
   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).
   66%test_failif_6 :- \+(3).
   67test_failif_7(X) :- \+(X).
   68test_failif_8(X) :- \+(X = f(X)). % Undefined behavior
   69
   70throws_exception(test_failif_6).
   71throws_exception(test_failif_7).
   72
   73
   74%
   75% not/1 test (equivalent to \+/1)
   76% - non-ISO -
   77%
   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)). % Undefined behavior
   87
   88throws_exception(test_not_6).
   89throws_exception(test_not_7).
   90
   91
   92%
   93% once/1 test
   94% - ISO -
   95%
   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)). % Undefined behavior
  102
  103
  104%
  105% ignore/1 test
  106% - non-ISO -
  107%
  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
  116%
  117% time/1 test
  118% - non-ISO -
  119%
  120
  121test_timepred_1 :- time(!). 
  122test_timepred_2 :- time(write(foo)).
  123test_timepred_3 :- time(time((write(foo), write(foo)))).
  124
  125
  126%
  127% maplist/2 test
  128% - non-ISO -
  129%
  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
  144%
  145% apply/2 test
  146% - non-ISO -
  147%
  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
  165%
  166% forall/2 test
  167% - non-ISO -
  168%
  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)