1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% Tests for other predicates
    3
    4%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    5
    6
    7%
    8% List of test suites
    9%
   10
   11test_suites([test_throw_catch, test_new_op, test_current_op]).
   12
   13
   14%
   15% throw/1 and catch/3 tests
   16% - ISO -
   17%
   18
   19db_throw_foo(X) :- Y is X * 2, throw(test(Y)).
   20db_throw_bar(X) :- X = Y, throw(Y).
   21db_throw_coo(X) :- throw(X).
   22db_throw_car(X) :- X = 1, throw(X).
   23
   24test_throw_catch_1(Y) :- catch(db_throw_foo(5), test(Y), true).
   25test_throw_catch_2(Z) :- catch(db_throw_bar(3), Z, true).
   26test_throw_catch_3(C) :- catch(true, C, write(demoen)), throw(bla).
   27test_throw_catch_4(X, Y) :- catch(db_throw_coo(X), Y, true).
   28test_throw_catch_5(X, Y) :- catch(db_throw_car(X), Y, true).
   29
   30throws_exception(test_throw_catch_3).
   31
   32
   33%
   34% op/3 test
   35% - ISO -
   36%
   37
   38% This test suite includes an extra test that uses a custom operator
   39% declared with an op/3 directive
   40
   41:- op(400, xfy, +*+).   42
   43test_new_op_1 :- op(30, xfy, ++).
   44test_new_op_2 :- op(0, yfx, ++).
   45test_new_op_3 :- op(max, xfy, ++).
   46test_new_op_4 :- op(-30, xfy, ++).
   47test_new_op_5 :- op(1201, xfy, ++).
   48test_new_op_6(XFY) :- op(30, XFY, ++).
   49test_new_op_7 :- op(30, xfy, 0).
   50test_new_op_8 :- op(30, xfy, ++), op(40, xfx, ++).
   51test_new_op_9 :- op(30, xfy, ++), op(50, yf, ++).
   52test_new_op_10(Y) :- X = 5 +*+ 7,
   53                     Y = +*+(3, X, 2).
   54
   55throws_exception(test_new_op_3).
   56throws_exception(test_new_op_4).
   57throws_exception(test_new_op_5).
   58throws_exception(test_new_op_6).
   59throws_exception(test_new_op_7).
   60%throws_exception(test_new_op_9). % Should throw an exception according to
   61                                  % 2nd draft of ISO Prolog Standard
   62
   63% The following test isn't included because some SWI-Prolog versions support
   64% the 'yfy' specifier, while other versions consider it as an invalid one.
   65%
   66%test_new_op_X1 :- op(30, yfy, ++).
   67
   68
   69%
   70% current_op/3 test
   71% - ISO -
   72%
   73
   74test_current_op_1(P, OP) :- current_op(P, xfy, OP)