use additional query (d3) iso d2

use additional query (d3) iso d2

#!/usr/bin/env gnuplot

# graph of power usage history

# datafiles
ifnameh = "/tmp/kamstrupd/mysql/kamh2.csv"
ifnamed = "/tmp/kamstrupd/mysql/kamd3.csv"
set output "/tmp/kamstrupd/site/img/kamstrup12.png"

# ******************************************************* General settings *****
set terminal png enhanced font "Vera,9" size 1280,320
set datafile separator ';'
set datafile missing "NaN"    # Ignore missing values
set grid front
tz_offset = utc_offset / 3600 # GNUplot only works with UTC. Need to compensate
                              # for timezone ourselves.
if (GPVAL_VERSION == 4.6) {epoch_compensate = 946684800} else {if (GPVAL_VERSION == 5.0) {epoch_compensate = 0}}
# Positions of split between graphs
LMARG = 0.06
LMPOS = 0.40
MRPOS = 0.73
RMARG = 0.94

# ************************************************************* Functions ******
# determine delta data
delta(x) = ( xD = x - old_x, old_x = x, xD <= 0 ? 0.1 : xD)
# lg(x)    = ( xL = x, xL == NaN ? NaN : log(xL) )
old_x = NaN

min(x,y) = (x < y) ? x : y
max(x,y) = (x > y) ? x : y

# ********************************************************* Statistics (R) *****
# stats to be calculated here of column 2 (UX-epoch)
stats ifnameh using 1 name "X" nooutput

Xh_min = X_min + utc_offset - epoch_compensate
Xh_max = X_max + utc_offset - epoch_compensate

# ********************************************************* Statistics (L) *****
# stats to be calculated here of column 2 (UX-epoch)
stats ifnamed using 1 name "X" nooutput
Xw_min = X_min + utc_offset - epoch_compensate
Xw_max = X_max + utc_offset - epoch_compensate

set multiplot layout 1, 2 title "Actueel Verbruik ".strftime("( %Y-%m-%dT%H:%M:%S )", time(0)+utc_offset)

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#                                                       LEFT PLOT: past week
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# ***************************************************************** X-axis *****
set xlabel "past day"       # X-axis label
set xdata time               # Data on X-axis should be interpreted as time
set timefmt "%s"             # Time in log-file is given in Unix format
set format x "%R"            # Display time in 24 hour notation on the X axis
set xrange [ Xw_min : Xw_max ]

# ***************************************************************** Y-axis *****
set ylabel "Verbruik [kWh]"
set yrange [ 0 : 1.6 ]

# ***************************************************************** Legend *****
set key opaque box inside top left
set key samplen 0.1
set key reverse horizontal Left
set key maxcols 2

# ***************************************************************** Output *****
# set arrow from graph 0,graph 0 to graph 0,graph 1 nohead lc rgb "red" front
# set arrow from graph 1,graph 0 to graph 1,graph 1 nohead lc rgb "green" front
#set object 1 rect from screen 0,0 to screen 1,1 behind
#set object 1 rect fc rgb "#eeeeee" fillstyle solid 1.0 noborder
#set object 2 rect from graph 0,0 to graph 1,1 behind
#set object 2 rect fc rgb "#ffffff" fillstyle solid 1.0 noborder

set lmargin at screen LMARG
set rmargin at screen MRPOS

# ***** PLOT *****
set style data boxes
set style fill solid noborder

plot ifnamed \
      using ($1+utc_offset):(delta($2+$3)/1000)  title "T1"  fc "green"  \
  ,'' using ($1+utc_offset):(delta($3)/1000)     title "T2"  fc "yellow"

old_x = NaN

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#                                                      RIGHT PLOT: past hour
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# ***************************************************************** X-axis *****
set xlabel "past hour"       # X-axis label
set xdata time               # Data on X-axis should be interpreted as time
set timefmt "%s"             # Time in log-file is given in Unix format
set format x "%R"            # Display time in 24 hour notation on the X axis
set xrange [ Xh_min : Xh_max ]
set xtics textcolor rgb "red"

# ***************************************************************** Y-axis *****
set ylabel " "
set yrange [ 0 : 0.16 ]
set ytics format " "

# ***************************************************************** Legend *****
unset key

# ***************************************************************** Output *****
set lmargin at screen MRPOS+0.001
set rmargin at screen RMARG

# ***** PLOT *****
plot ifnameh \
      using ($1+utc_offset):(delta($2+$3)/1000)  title "T1"  fc "green"  \
  ,'' using ($1+utc_offset):(delta($3)/1000)     title "T2"  fc "yellow"

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#                                                                 FINALIZING
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

unset multiplot

#!/usr/bin/env gnuplot

# graph of power usage history

# datafiles
ifnameh = "/tmp/kamstrupd/mysql/kamh2.csv"
ifnamed = "/tmp/kamstrupd/mysql/kamd2.csv"
set output "/tmp/kamstrupd/site/img/kamstrup12.png"

# ******************************************************* General settings *****
set terminal png enhanced font "Vera,9" size 1280,320
set datafile separator ';'
set datafile missing "NaN"    # Ignore missing values
set grid front
tz_offset = utc_offset / 3600 # GNUplot only works with UTC. Need to compensate
                              # for timezone ourselves.
if (GPVAL_VERSION == 4.6) {epoch_compensate = 946684800} else {if (GPVAL_VERSION == 5.0) {epoch_compensate = 0}}
# Positions of split between graphs
LMARG = 0.06
LMPOS = 0.40
MRPOS = 0.73
RMARG = 0.94

# ************************************************************* Functions ******
# determine delta data
delta(x) = ( xD = x - old_x, old_x = x, xD <= 0 ? 0.1 : xD)
# lg(x)    = ( xL = x, xL == NaN ? NaN : log(xL) )
old_x = NaN

min(x,y) = (x < y) ? x : y
max(x,y) = (x > y) ? x : y

# ********************************************************* Statistics (R) *****
# stats to be calculated here of column 2 (UX-epoch)
stats ifnameh using 1 name "X" nooutput

Xh_min = X_min + utc_offset - epoch_compensate
Xh_max = X_max + utc_offset - epoch_compensate

# ********************************************************* Statistics (L) *****
# stats to be calculated here of column 2 (UX-epoch)
stats ifnamed using 1 name "X" nooutput
Xw_min = X_min + utc_offset - epoch_compensate
Xw_max = X_max + utc_offset - epoch_compensate

set multiplot layout 1, 2 title "Actueel Verbruik ".strftime("( %Y-%m-%dT%H:%M:%S )", time(0)+utc_offset)

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#                                                       LEFT PLOT: past week
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# ***************************************************************** X-axis *****
set xlabel "past day"       # X-axis label
set xdata time               # Data on X-axis should be interpreted as time
set timefmt "%s"             # Time in log-file is given in Unix format
set format x "%R"            # Display time in 24 hour notation on the X axis
set xrange [ Xw_min : Xw_max ]

# ***************************************************************** Y-axis *****
set ylabel "Verbruik [kWh]"
set yrange [ 0 : 1.6 ]

# ***************************************************************** Legend *****
set key opaque box inside top left
set key samplen 0.1
set key reverse horizontal Left
set key maxcols 2

# ***************************************************************** Output *****
# set arrow from graph 0,graph 0 to graph 0,graph 1 nohead lc rgb "red" front
# set arrow from graph 1,graph 0 to graph 1,graph 1 nohead lc rgb "green" front
#set object 1 rect from screen 0,0 to screen 1,1 behind
#set object 1 rect fc rgb "#eeeeee" fillstyle solid 1.0 noborder
#set object 2 rect from graph 0,0 to graph 1,1 behind
#set object 2 rect fc rgb "#ffffff" fillstyle solid 1.0 noborder

set lmargin at screen LMARG
set rmargin at screen MRPOS

# ***** PLOT *****
set style data boxes
set style fill solid noborder

plot ifnamed \
      using ($1+utc_offset):(delta($2+$3)/1000)  title "T1"  fc "green"  \
  ,'' using ($1+utc_offset):(delta($3)/1000)     title "T2"  fc "yellow"

old_x = NaN

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#                                                      RIGHT PLOT: past hour
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# ***************************************************************** X-axis *****
set xlabel "past hour"       # X-axis label
set xdata time               # Data on X-axis should be interpreted as time
set timefmt "%s"             # Time in log-file is given in Unix format
set format x "%R"            # Display time in 24 hour notation on the X axis
set xrange [ Xh_min : Xh_max ]
set xtics textcolor rgb "red"

# ***************************************************************** Y-axis *****
set ylabel " "
set yrange [ 0 : 0.16 ]
set ytics format " "

# ***************************************************************** Legend *****
unset key

# ***************************************************************** Output *****
set lmargin at screen MRPOS+0.001
set rmargin at screen RMARG

# ***** PLOT *****
plot ifnameh \
      using ($1+utc_offset):(delta($2+$3)/1000)  title "T1"  fc "green"  \
  ,'' using ($1+utc_offset):(delta($3)/1000)     title "T2"  fc "yellow"

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#                                                                 FINALIZING
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

unset multiplot


Made executable script.

Made executable script.

#!/usr/bin/gnuplot

set style data errorlines
set logscale x
set grid xtics mxtics ytics
#set ylabel "m2o"
unset ylabel
unset title
set terminal pdf mono size 3,2

set xlabel "number of random substitutes per word"
set xrange [0.9:100]
set yrange [0.7:0.8]
set ytics 0.01
set key top right
set output "plot-s.pdf"
plot "plot-s.dat" title "m2o"

set xlabel "number of random partitions"
set xrange [3000:400000]
set yrange [0.7:0.8]
set ytics 0.01
set key top right
set output "plot-p.pdf"
plot "plot-p.dat" title "m2o"

set xlabel "number of s-code dimensions"
set xrange [1:400]
set yrange [0.35:0.8]
set ytics 0.05
set key bottom right
set output "plot-d.pdf"
plot "plot-d.dat" title "m2o"

set xlabel "s-code Z approximation"
set xrange [0.005:4]
set yrange [0.7:0.8]
set ytics 0.01
set key top right
set output "plot-z.pdf"
plot "plot-z.dat" title "m2o"

set style data errorlines
set logscale x
set grid xtics mxtics ytics
#set ylabel "m2o"
unset ylabel
unset title
set terminal pdf mono size 3,2

set xlabel "number of random substitutes per word"
set xrange [0.9:100]
set yrange [0.7:0.8]
set ytics 0.01
set key top right
set output "plot-s.pdf"
plot "plot-s.dat" title "m2o"

set xlabel "number of random partitions"
set xrange [3000:400000]
set yrange [0.7:0.8]
set ytics 0.01
set key top right
set output "plot-p.pdf"
plot "plot-p.dat" title "m2o"

set xlabel "number of s-code dimensions"
set xrange [1:400]
set yrange [0.35:0.8]
set ytics 0.05
set key bottom right
set output "plot-d.pdf"
plot "plot-d.dat" title "m2o"

set xlabel "s-code Z approximation"
set xrange [0.005:4]
set yrange [0.7:0.8]
set ytics 0.01
set key top right
set output "plot-z.pdf"
plot "plot-z.dat" title "m2o"

set terminal x11


db_erase_other_db UT

db_erase_other_db UT

:- begin_tests(vd, [setup(setup)]).

:- multifile prolog:message//1.

:- use_module(u(v)).
:- use_module(u(vd)).
:- use_module(u(internal/db_i)).
:- use_module(u(internal/objects_i)).
:- use_module(u(util/lambda)).
:- use_module(library(aggregate)).
:- use_module(library(ordsets)).

test(clear_test_db, [fail, setup(db_clear(people))]) :-

	db_recorded(people, _).

test(db_clear, [setup(model_db), List == []]) :-

   reload_classes,

   % clear all DBs with citizen_v
   (  db_name(DB_Key),
      (  named_args_unify(DB_Key, citizen_v, [], [], _)
      -> db_clear(DB_Key)
      ;  true
      ),
      fail ; true
   ),

   findall(X,
           (db_i:current_predicate(citizen_v, X), call(db_i:X)),
           List).

test(db_copy, [setup(model_db), N =:= 3]) :-

   db_copy(people, people2),
   findall('.', db_recorded(people2, _), L),
   length(L, N).

test(db_erase1, [setup(model_db)]) :-
   (  named_args_unify(people, _,
                       [weight, surname], [73, _], X),
      db_erase(X),
      fail ; true
   ),
   findall(Y,
           db_recorded(people, Y),
           LY),
   assertion(LY = [man_v(_, _, _, _, _, 'Eva', woman, _, _)]).

test(db_erase2, [setup(db_clear(people))]) :-
   db_construct(people, citizen_v,
                [birthday, sex],
                [1994, man], C1),
   db_size(people, S1),
   assertion(S1 == 1),
   obj_downcast(C1, C2),
   functor(C2, CC, _),
   assertion(CC == callup_v),
   db_erase(C2),
   db_size(people, S2),
   assertion(S2 == 0).

test(db_erase_other_db, [setup((db_clear(people), db_clear(people2)))]) :-
   db_construct(people, man_v, [], [], M1),
   db_construct(people2, man_v, [], []),
   obj_rewrite(M1, [db_key], [_], [people2], MM1),
   db_erase(MM1),
   db_size(people, S1),
   db_size(people2, S2),
   assertion(S1 == 1),
   assertion(S2 == 0).

test(db_iterate1, [setup(model_db), N =:= 3]) :-

   findall('.', db_iterate(people, true, _), L),
   length(L, N).

test(db_iterate2, [setup(model_db), N =:= 2]) :-

   findall(O, db_iterate(people, sex(man), O), L),
   length(L, N).

test(db_iterate3, [setup(model_db), fail]) :-

   db_iterate(people, unexisting_name(man_v), _).

test(db_iterate4, [setup(model_db), N =:= 2]) :-

   findall(O, db_iterate(people, functor(man_v), O), L),
   length(L, N).

test(db_iterate5, [setup(model_db), N =:= 3]) :-

   findall(O, db_iterate(people, functor(_), O), L),
   length(L, N).

test(db_iterate6, [setup(model_db), N =:= 3]) :-

   findall(O, db_iterate(people, same_or_descendant(man_v), O), L),
   length(L, N).

test(db_iterate7, [setup(model_db), N =:= 1]) :-

   findall(O, db_iterate(people, same_or_descendant(citizen_v), O), L),
   length(L, N).

test(db_iterate8, [setup(model_db)]) :-

   findall(Surname, db_iterate(people, surname(Surname), _), SL),
   assertion(SL =@= [_, _, 'Mayakovsky']),
   findall(Surname, db_iterate(people, sex(Surname), _), SL2),
   assertion(SL2 == [man, woman, man]).

test(db_iterate9, [setup(model_db), N == 1]) :-

   aggregate_all(count, db_iterate(people, surname(+bound), _), N).

test(db_iterate10, [setup(model_db), N == 2]) :-

   aggregate_all(count, db_iterate(people, surname(+free), _), N).

test(db_iterate11, [setup(model_db)]) :-

   aggregate_all(count,
                 db_iterate(people,
                            surname('Mayakovsky') /\ surname(+free), _),
                 N1),
   assertion(N1 == 0),
   aggregate_all(count,
                 db_iterate(people,
                            surname(+free) /\ surname('Mayakovsky'), _),
                 N2),
   assertion(N2 == 0),
   aggregate_all(count,
                 db_iterate(people,
                            surname(+free) /\ surname(+bound), _),
                 N3),
   assertion(N3 == 0),
   aggregate_all(count,
                 db_iterate(people,
                            surname(+free) \/ surname(+bound), _),
                 N4),
   assertion(N4 == 3),
   aggregate_all(count,
                 db_iterate(people,
                            surname('Mayakovsky') /\ surname(+bound), _),
                 N5),
   assertion(N5 == 1),
   aggregate_all(count,
                 db_iterate(people,
                            surname(+bound) /\ surname('Mayakovsky'), _),
                 N6),
   assertion(N6 == 1).

test(db_to_list, [setup(model_db)]) :-

   db_to_list(people, man_v, L1),
   length(L1, N1),
   assertion(N1 =:= 2),

   db_to_list(people, citizen_v, L2),
   length(L2, N2),
   assertion(N2 =:= 1),

   db_to_list(people, _, L3),
   length(L3, N3),
   assertion(N3 =:= 3).

test(db_put_object1,
     [setup(model_db),
      List == [['Adam'], ['Eva'], ['Moses'], ['Vladimir']]
      ]) :-

   obj_construct(man_v, [name], ['Moses'], Man),
   db_put_object(people, Man),
   db_select_list(people, _, [name], List).

test(db_put_object2, [setup(model_db)]) :-

   obj_construct(man_v, [name], ['Moses'], Man0),
   obj_rebase((object_v -> db_object_v), Man0, Man),
   db_put_object(people, Man).

test(db_put_object3,
     [setup(model_db),
      error(db_obj_replace_protector(people2, _, Man))]) :-

   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man), !,
   db_put_object(people2, Man).

test(db_put_object4, [setup(model_db)]) :-
% replacing

   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_rewrite(Man0, [name], ['Moses'], [_], Man1),
   db_put_object(people2, throw, Man1, Man2, Replaced),
   named_args_unify(Man2,
                    [name, db_key, db_ref],
                    [New_Name, DB_Key, DB_Ref]),
   assertion(New_Name =@= _),
   assertion(Replaced == replaced),
   assertion(nonvar(DB_Ref)),
   assertion(DB_Key == people2),

   db_size(people2, N),
   assertion(N =:= 1).

% replacing rebased
test(db_put_object4_1, [setup(model_db), error(class_parents_mismatch(_,_,_,_))]) :-
   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_rewrite(Man0, [name], ['Moses'], [_], Man1),
   obj_parents(Man1, [man_v, tarjan_vertex_v, db_object_v, object_v, object_base_v], Man2),
   db_put_object(people2, throw, Man2, _, _).

% replacing downcasted
test(db_put_object4_2, [setup(db_clear(people2))]) :-
   db_construct(people2, citizen_v,
                [birthday, sex, name, surname, id],
                [1994, man, l, k, 199442]),
   db_recorded(people2, Man1), !,
   obj_downcast(Man1, callup_v, Man2),
   db_put_object(people2, throw, Man2, Man3, Replaced),
   named_args_unify(Man3,
                    [name, db_key, db_ref],
                    [New_Name, DB_Key, DB_Ref]),
   assertion(New_Name == l),
   assertion(Replaced == replaced),
   assertion(nonvar(DB_Ref)),
   assertion(DB_Key == people2),
   db_size(people2, N),
   assertion(N =:= 1).

% replace with incorrect db_key
test(db_put_object4_3,
     [setup((db_clear(people), db_clear(people2))),
      error(_)]) :-
   db_construct(people, man_v, [name, surname], [1,2], M1),
   db_construct(people2, man_v, [name,surname], [1,2]),
   obj_rewrite(M1, [db_key, deb_ref], [_, _], [people2, _], MM1),
   db_put_object(people, throw, MM1, _, _).

test(db_put_object5,
     [setup(model_db),
      error(domain_error(unbound_db_ref, DB_Ref))]) :-

   db_construct(people, man_v, [name], ['Moses']),
   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_field(Man0, db_ref, DB_Ref),
   db_put_object(people, throw, Man0, _, _).

test(db_put_object6,
     [setup(model_db),
      error(domain_error(unbound_or_same_db_key, people2))]) :-

   db_construct(people, man_v, [name], ['Moses']),
   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_reset_fields([db_ref], Man0, Man),
   db_put_object(people, throw, Man, _, _).

test(db_put_object7,
     [setup(model_db),
      error(db_obj_replace_protector(people2, replaced, Man1))]) :-

   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_rewrite(Man0, [db_ref, name], [_, 'Moses'], [_, _], Man1),
   db_put_object(people2, throw, Man1, _, replaced).
   % does not replace because of unbound db_ref

test(db_put_object8,
     [setup(model_db),
      error(db_obj_replace_protector(people2, replaced, Man))]) :-

   db_construct(people2, man_v, [name], ['Moses']),
   obj_construct(man_v, [name], ['Simeon'], Man),
   db_put_object(people2, _, Man, _, replaced).
   % does not replace because of not db_object_v descendant

test(db_put_object9,
     [blocked(rebase_collision), setup(model_db),
      List == [['Adam'], ['Eva'], ['Moses'], ['Vladimir']]
      ]) :-

   obj_construct(man_v, [name], ['Moses'], Man0),
   obj_rebase((object_v -> db_object_v), Man0, Man1),
   obj_rebase((object_v -> tarjan_vertex_v), Man1, Man),
   db_put_object(people, Man),
   db_select_list(people, _, [name], List).

test(db_recorda1,
     [setup(model_db),
      List == [['Moses'], ['Adam'], ['Eva'], ['Vladimir']]
      ]) :-

   obj_construct(man_v, [name], ['Moses'], Man),
   db_recorda(people, Man),
   db_select_list(people, _, [name], List).

test(db_put_objects,
    [setup(db_clear(people)),
     DB_Size =:= 3]
    ) :-

	maplist(obj_construct(man_v, [name]),
		[['Valera'], ['Vika'], ['Yura']],
		Men),

	db_put_objects(people,
		       Men+\El^member(El, Men),
		       fail),

	db_size(people, DB_Size).

test(db_recorded_bug1, [setup(model_db), N =:= 3]) :-

   findall('.', db_recorded(people, _), L),
   length(L, N).

test(db_recorded1,
     [setup(model_db),
      error(domain_error(db_object_v_descendant, X))]) :-

   obj_construct(man_v, [sex], [man], X),
   db_recorded(people, X).

test(db_recorded2, [setup(model_db)]) :-

   findall('.',
           (obj_construct(man_v, [sex], [man], X0),
            obj_rebase((object_v -> db_object_v), X0, X),
            db_recorded(people, X)),
           L2),
   length(L2, N2),
   assertion(N2 =:= 1).

test(db_recorded3, [setup(model_db)]) :-

   findall('.',
           (obj_construct(man_v, [], [], X0),
            obj_rebase((object_v -> db_object_v), X0, X),
            db_recorded(people, X)),
           L2),
   length(L2, N2),
   assertion(N2 =:= 2).

test(db_recorded4, [setup(model_db)]) :-

   findall('.',
           (obj_construct(man_v, [height], [1.76], X0),
            obj_rebase((object_v -> db_object_v), X0, X),
            db_recorded(people, X)),
           L2),
   length(L2, N2),
   assertion(N2 =:= 2).

test(db_recorded5, [setup(db_clear(people))]) :-

   db_construct(people, man_v, [], []),
   db_recorded(people, X), !,
   db_recorded(people, X).

% test(db_rewrite1,
%      [setup(model_db),
%       List =@= [['Adam', 'Kasperski', 66],
%                 ['Eva', 'Kasperski', 66],
%                 ['Vladimir', 'Kasperski', 66]]
%      ]) :-

%    db_rewrite(people, _,
%               [weight, surname], _, [66, 'Kasperski']),
%    db_select_list(people, _, [name, surname, weight], List).

% test(db_rewrite2,
%      [setup(model_db),
%       List =@= [['Adam', 'Kasperski', 66],
%                 ['Eva', 'Kasperski', 66],
%                 ['Vladimir', 'Mayakovsky', _]]
%      ]) :-

%    db_rewrite(people, man_v,
%               [weight, surname], _, [66, 'Kasperski']),
%    db_select_list(people, _, [name, surname, weight], List).

test(db_search,
     [setup(model_db),
      List == [['Adam'], ['Vladimir']]
     ]) :-

   db_search(people, people2, db_search_pred),
   db_select_list(people2, _, [name], List).

db_search_pred(Man) :-

  obj_field(Man, sex, Sex),
  Sex == man.

test(db_select1,
     [setup(model_db),
      List =@= [[man_v, man, 'Adam', _, 73, _],
                [man_v, woman, 'Eva', _, 64, _],
                [citizen_v, man, 'Vladimir', 'Mayakovsky', _,
                 ['Soviet Union']]]
      ]) :-

   findall(Row,
           db_select(people,
                     [class, sex, name, surname, weight, country],
                     Row),
           List
          ).

test(db_select2,
     [setup(model_db),
      List =@= [[man_v, man, 'Adam', _, 73, _],
                [man_v, woman, 'Eva', _, 64, _]]
      ]) :-

   findall(Row,
           (   Row = [man_v|_],
               db_select(people,
                         [functor, sex, name, surname, weight,
                          country],
                         Row)
           ), List
          ).

test(db_select3,
     [setup((model_db,
      db_construct(people, citizen_v, [id, sex, name, age], [2, man, 'Igor', 19]))),
     Classes == [callup_v]]) :-
   findall(Class, db_select(people,  [name, class], ['Igor', Class]), Classes).

test(db_select_list1,
     [setup(model_db),
      List =@= [[man_v, man, 'Adam', _, 73, _],
                [man_v, woman, 'Eva', _, 64, _],
                [citizen_v, man, 'Vladimir', 'Mayakovsky', _,
                 ['Soviet Union']]]
      ]) :-

   db_select_list(people, _,
                  [class, sex, name, surname, weight, country],
                  List).

test(db_select_list2,
     [setup(model_db),
      List =@= [[man_v, man, 'Adam', _, 73, _],
                [man_v, woman, 'Eva', _, 64, _]]
      ]) :-

   db_select_list(people, man_v, _,
                  [class, sex, name, surname, weight, country],
                  List).

test(db_select_list3,
     [setup(model_db),
      error(no_object_field(_, country))
      ]) :-

   db_select_list(people, man_v, throw,
                  [class, sex, name, surname, weight, country],
                  _).

test(filter_on_db,
     [setup(model_db),
      List = [['Adam'], ['Vladimir']]
     ]) :-

   filter_on_db(people, [sex], [man]),
   db_select_list(people, _, [name], List).

test(named_args_unify1, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, _, [sex], [man], _),
           ['.', '.']).

test(named_args_unify2, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, _, [sex, sex], [man, man], _),
           ['.', '.']).

test(named_args_unify3_eval, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, _, [sex, age], [_, _], _),
           ['.']).

test(named_args_unify_bug1, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, citizen_v, [sex], [man], _),
           ['.']).

test(named_args_unify_bug2, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, _, [], [], _),
           ['.', '.', '.']).

test(eval_obj_expr1,
     [setup(model_db),
     List == ['Adam', 'Eva', 'Vladimir']]) :-
   findall(Name, @people / name ^= Name, List).

test(eval_obj_expr2, [setup(model_db)]) :-
   findall(Object, ((@people -> Object) / functor ^= citizen_v), Os),
   assertion(Os / surname =^= ['Mayakovsky']).

test(store_and_retrieve1,
    [setup(db_clear(people)),
     man(Sex, Name, Surname, Weight, Height) ==
     man(man, 'Adam', 'Adamov', 1, 3)]
    ) :-

	obj_construct(man_v,
		      [sex, name, surname, weight, height],
		      [man, 'Adam', 'Adamov', 1, 3],
		      Man),

	db_put_object(people, Man, Man1),

	assertion(obj_is_descendant(Man1, db_object_v)),
	assertion(\+ obj_is_descendant(Man1, man_v)),
	assertion(\+ obj_is_descendant(Man, db_object_v)),

	obj_field(Man1, sex, Sex),
	obj_field(Man1, name, Name),
	obj_field(Man1, surname, Surname),
	obj_field(Man1, weight, Weight),
	obj_field(Man1, height, Height).

test(key_rule1,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),
   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']).

test(key_rule2,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v, [], []),
   db_construct(people, man_v, [], []).

test(key_rule3,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v, [name], ['Sergei']),
   db_construct(people, man_v, [], []).

test(key_rule4,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v, [], []),
   db_construct(people, man_v, [name], ['Sergei']).

test(key_rule5, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Sikorsky']).

test(key_rule6,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name], ['Sergei']),

   db_construct(people, man_v,
                [name], ['Sergei']).

test(key_rule7,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name], ['Sergei']),

   db_construct(people, man_v,
                [surname], ['Lodyagin']).

test(key_rule8, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name], ['Sergei']),

   db_construct(people, man_v,
                [name], ['Artem']).

test(key_rule9,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Sysoev']),

   db_construct(people, man_v,
                [name], ['Sergei']).

test(key_rule10,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name], ['Sergei']),

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Sysoev']).

test(key_rule11,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, citizen_v, [], []).

test(key_rule12,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, man_v, [], []).

test(key_rule13,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, man_v, [name], ['James']).

test(key_rule14,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, man_v, [], []),
   db_construct(people, citizen_v, [id], [5]).

test(key_rule15,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, man_v,
                [name, surname], ['James', 'Crick']).

test(key_rule16,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v, [name], ['James']),
   db_construct(people, citizen_v, [id], [4]).

test(key_test1) :-
   obj_construct(c4_v, [a, b, c], [1, 2, 3], A),
   obj_construct(c4_v, [a, b, c], [1, 20, 30], B),
   key_test2(A, B, allow).

% nearest_keymaster(A) = nearest_keymaster(B)
test(key_test_set1) :-

   key_test(c1_v, c2_v).

% nearest_keymaster(A) is_accessor_off nearest_keymaster(B)
test(key_test_set2) :-

   key_test(c1_v, c3_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c1_v, c4_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c1_v, c5_v), % key(nk(A)) = key(nk(B))
   key_test(c1_v, c6_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c1_v, c7_v). % key(nk(A)) instersect key(nk(B)) = {}

% nearest_keymaster(A) is_desc_off nearest_keymaster(B)
test(key_test_set3) :-

   key_test(c4_v, c1_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c3_v, c1_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c5_v, c1_v), % key(nk(A)) = key(nk(B))
   key_test(c6_v, c1_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c7_v, c1_v). % key(nk(A)) instersect key(nk(B)) = {}

% nk(A) no_parent_relation_to nk(B) /\ key(nk(A, B)) = {}
test(key_test_set4_1) :-

   key_test(c1_v, d2_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c1_v, d3_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c1_v, d4_v), % key(nk(A)) = key(nk(B))
   key_test(c1_v, d5_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c1_v, d6_v). % key(nk(A)) instersect key(nk(B)) = {}

% nk(A) no_parent_relation_to nk(B) /\ key(nk(A, B)) /= {}
test(key_test_set4_2) :-

   key_test(c5_v, e2_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c5_v, e3_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c5_v, e4_v), % key(nk(A)) = key(nk(B))
   key_test(c5_v, e5_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c5_v, e6_v). % key(nk(A)) instersect key(nk(B)) = {}

% nk(A) no_parent_relation_to nk(B) /\ key(nk(A, B)) = key(nk(A))
test(key_test_set4_3) :-

   key_test(c5_v, f2_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c5_v, f3_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c5_v, f4_v), % key(nk(A)) = key(nk(B))
   key_test(c5_v, f5_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c5_v, f6_v). % key(nk(A)) instersect key(nk(B)) = {}

% nk(A) no_parent_relation_to nk(B) /\ key(nk(A, B)) = key(nk(B))
test(key_test_set4_4) :-

   key_test(f3_v, c5_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(f2_v, c5_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(f4_v, c5_v), % key(nk(A)) = key(nk(B))
   key_test(f5_v, c5_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(f6_v, c5_v). % key(nk(A)) instersect key(nk(B)) = {}

test(db_properties_v1_overwrite, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),
   db_construct(people, db_properties_v,
                [key_policy], [overwrite]),
   db_construct(people, man_v, [surname], ['Lodyagin']),

   findall([Name, Surname],
           named_args_unify(people, _, [name, surname],
                            [Name, Surname], _),
           List1),
   assertion(List1 =@= [[_, 'Lodyagin']]).

test(db_properties_v2_throw,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),
   db_construct(people, db_properties_v,
                [key_policy], [overwrite]),
   db_construct(people, man_v, [surname], ['Lodyagin']),
   db_construct(people, db_properties_v,
                [key_policy], [throw]),
   db_construct(people, man_v, [name], ['Sergei']).

test(db_properties_v3_fail_ignore, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin'], Obj1),
   db_construct(people, db_properties_v,
                [key_policy], [fail]),
   \+ db_construct(people, man_v, [surname], ['Lodyagin']),

   named_args_unify(people, db_properties_v, [], _, Singl1), !,
   obj_rewrite(Singl1, [key_policy], [fail], [ignore], Singl2),
   db_put_object(people, _, Singl2, _, replaced),

   db_construct(people, man_v,
                [name, surname, height], ['Sergei', 'Lodyagin',
                1.74], Obj2),

   findall([Name, Surname, Height],
           named_args_unify(people, _,
                            [name, surname, height],
                            [Name, Surname, Height], _),
           List1),
   assertion(List1 =@= [['Sergei', 'Lodyagin', _]]),
   assertion(Obj1 =@= Obj2).

test(db_properties_v4_fail_ignore2, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin'], Obj1),
   db_construct(people, db_properties_v,
                [key_policy], [fail]),
   \+ db_construct(people, man_v, [surname], ['Lodyagin']),

   obj_construct(db_properties_v, [key_policy], [ignore], Singl2),
   db_put_object(people, overwrite, Singl2, _),

   db_construct(people, man_v,
                [name, surname, height], ['Sergei', 'Lodyagin',
                1.74], Obj2),

   findall([Name, Surname, Height],
           named_args_unify(people, _,
                            [name, surname, height],
                            [Name, Surname, Height], _),
           List1),
   assertion(List1 =@= [['Sergei', 'Lodyagin', _]]),
   assertion(Obj1 =@= Obj2).

test(db_properties_v5_invalid_policy,
     [setup(db_clear(people)),
      blocked(need_to_see)
      ]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),
   db_construct(people, db_properties_v,
                [key_policy], [throws]),
   db_construct(people, man_v, [surname], ['Lodyagin']).

test(rebase_collision_bug1, [blocked(rebase_collision)]) :-

   obj_construct(man_v, [], [], O0),
   obj_rebase((object_v -> tarjan_vertex_v), O0, O),
   db_put_object(people, O).

% check default key policy
test(after_put_callback1,
     [setup(callback_setup),
      error(db_key_exists(people, _, _))
     ]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),

   context_module(This),
   db_construct(people, db_properties_v,
                [after_put_callback], [This:after_put_callback]),

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']).

test(after_put_callback2,
     [setup(callback_setup)]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),

   context_module(This),
   db_construct(people, db_properties_v,
                [after_put_callback], [This:after_put_callback], Props),

   db_construct(people, man_v,
                [name, surname], ['Alex', 'Petrenko']),

   obj_rewrite(Props, [key_policy], _, [fail], Props2),
   db_put_object(people, _, Props2, Props3, replaced),
   ignore(db_construct(people, man_v,
                       [name, surname], ['Alex', 'Petrenko'])),

   obj_rewrite(Props3, [after_put_callback], _, [_], Props4),
   db_put_object(people, _, Props4, _, replaced),

   db_construct(people, man_v,
                [name, surname], ['James', 'Petrenko']),

   findall(p(Functor, Name, Surname),
           (  apc(Obj),
              obj_unify(Obj, weak,
                        [functor, name, surname], [Functor, Name, Surname])
           ),
           List),

   assertion(List = [p(db_properties_v, _, _),
                     p(man_v, 'Alex', 'Petrenko'),
                     p(db_properties_v, _, _),
                     p(db_properties_v, _, _),
                     p(man_v, 'James', 'Petrenko')
                     ]).

after_put_callback(Obj) :-

   assertz(apc(Obj)).

callback_setup :-

   db_clear(people),
   retractall(apc(_)).

model_db :-

	db_clear(people),
	db_clear(people2),

        db_construct(people, man_v,
                     [sex, name, weight], [man, 'Adam', 73]),
        db_construct(people, man_v,
                     [sex, name, weight], [woman, 'Eva', 64]),

        db_construct(people, citizen_v,
                      [sex, name, surname, country, id],
                      [man, 'Vladimir', 'Mayakovsky',
                       ['Soviet Union'], 1]).

setup :-

   db_clear(plunit_vd__key_test),
   reload_classes.

reload_classes :-

   current_prolog_flag(verbose, Old_Verbose),
   set_prolog_flag(verbose, silent),
   reload_all_classes,
   set_prolog_flag(verbose, Old_Verbose),
   key_test_classes.

key_test_classes :-

   class_create(c0_v, object_v, [a, b, c], [a]),
   class_create(c1_v, c0_v, [], [b, c]),
   class_create(c2_v, c1_v, [d]),
   class_create(c3_v, c2_v, [], [c]),
   class_create(c4_v, c3_v, [], [a, b, c]),
   class_create(c5_v, c1_v, [], [b, c]),
   class_create(c6_v, c1_v, [d], [c, d]),
   class_create(c7_v, c1_v, [e], [a, e]),

   class_create(d1_v, object_v, [a, b, c], [a]),
   class_create(d2_v, d1_v, [], [b]),
   class_create(d3_v, d1_v, [], [a, b, c]),
   class_create(d4_v, d3_v, [], [b, c]),
   class_create(d5_v, d2_v, [], [a, b]),
   class_create(d6_v, d2_v, [f], [c, f]),

   class_create(e1_v, c0_v, [], [b]),
   class_create(e2_v, e1_v, [], [b]),
   class_create(e3_v, e1_v, [], [a, b, c]),
   class_create(e4_v, e3_v, [], [b, c]),
   class_create(e5_v, e2_v, [], [a, b]),
   class_create(e6_v, e2_v, [g], [c, g]),

   class_create(f1_v, c1_v, [], [a]),
   class_create(f2_v, f1_v, [], [b]),
   class_create(f3_v, f1_v, [], [a, b, c]),
   class_create(f4_v, f3_v, [], [b, c]),
   class_create(f5_v, f2_v, [], [a, b]),
   class_create(f6_v, f2_v, [h, j], [j, h]).

key_pattern(patt(Left, Common, Right)) :-
   L = [free, bound],
   member(Left, L),
   member(Common, L),
   member(Right, L).

key_test(AC, BC) :-
   class_primary_id(AC, Id1),
   class_primary_id(BC, Id2),
   nearest_common_keymaster_int(Id1, Id2, Keymaster_Id),
   forall(
          key_pattern(Patt),
          (   fill_keys(AC, BC, Keymaster_Id, Patt, A, B),
              assertion(key_test2(A, B))
	  )).

% Calculate the result
key_test_result(A, B, allow) :-
   ( obj_key(A, []) ; obj_key(B, [])), !.
key_test_result(A, B, conflict) :-
   arg(1, A, Id1),
   arg(1, B, Id2),
   nearest_common_keymaster_int(Id1, Id2, Keymaster_Id),
   get_key(Keymaster_Id, K_Key),
   K_Key \= [],
   obj_unify(A, K_Key, Value),
   obj_unify(B, K_Key, Value), !.
key_test_result(_, _, allow).

key_test2(A, B) :-
   key_test_result(A, B, Conflict),
   key_test2(A, B, Conflict).

key_test2(A, B, allow) :-
   DB = plunit_vd__key_test,
   db_clear(DB),
   db_put_object(DB, A),
   db_put_object(DB, fail, B, _),
   db_clear(DB),
   db_put_object(DB, B),
   db_put_object(DB, fail, A, _), !.

key_test2(A, B, conflict) :-
   DB = plunit_vd__key_test,
   db_clear(DB),
   db_put_object(DB, A),
   \+ db_put_object(DB, fail, B, _),
   db_clear(DB),
   db_put_object(DB, B),
   \+ db_put_object(DB, fail, A, _).

fill_keys(AC, BC, Keymaster_Id, Patt, A, B) :-
   get_key(Keymaster_Id, Common_Key_Part),
   obj_construct(AC, [], [], A),
   obj_construct(BC, [], [], B),
   fill_key(Patt, Common_Key_Part, A, B).

fill_key(patt(A_Patt, Common_Patt, B_Patt), Common_Key, A, B) :-
   obj_key(A, A_Key),
   obj_unify(A, A_Key, A_Key_Value),
   fill_key(A_Patt, A_Key, A_Key_Value),
   obj_unify(A, Common_Key, Common_Key_Value),
   fill_key(Common_Patt, Common_Key, Common_Key_Value),
   obj_key(B, B_Key),
   obj_unify(B, B_Key, B_Key_Value),
   fill_key(B_Patt, B_Key, B_Key_Value).

fill_key(bound, Key, Key) :- !.
fill_key(half_bound, [K|KT], [K|KVT]) :- !,
   same_length(KT, KVT).
fill_key(free, Key, Key_Value) :-
   same_length(Key, Key_Value).

:- end_tests(vd).

:- begin_tests(vd, [setup(setup)]).

:- multifile prolog:message//1.

:- use_module(u(v)).
:- use_module(u(vd)).
:- use_module(u(internal/db_i)).
:- use_module(u(internal/objects_i)).
:- use_module(u(util/lambda)).
:- use_module(library(aggregate)).
:- use_module(library(ordsets)).

test(clear_test_db, [fail, setup(db_clear(people))]) :-

	db_recorded(people, _).

test(db_clear, [setup(model_db), List == []]) :-

   reload_classes,

   % clear all DBs with citizen_v
   (  db_name(DB_Key),
      (  named_args_unify(DB_Key, citizen_v, [], [], _)
      -> db_clear(DB_Key)
      ;  true
      ),
      fail ; true
   ),

   findall(X,
           (db_i:current_predicate(citizen_v, X), call(db_i:X)),
           List).

test(db_copy, [setup(model_db), N =:= 3]) :-

   db_copy(people, people2),
   findall('.', db_recorded(people2, _), L),
   length(L, N).

test(db_erase1, [setup(model_db)]) :-
   (  named_args_unify(people, _,
                       [weight, surname], [73, _], X),
      db_erase(X),
      fail ; true
   ),
   findall(Y,
           db_recorded(people, Y),
           LY),
   assertion(LY = [man_v(_, _, _, _, _, 'Eva', woman, _, _)]).

test(db_erase2, [setup(db_clear(people))]) :-
   db_construct(people, citizen_v,
                [birthday, sex],
                [1994, man], C1),
   db_size(people, S1),
   assertion(S1 == 1),
   obj_downcast(C1, C2),
   functor(C2, CC, _),
   assertion(CC == callup_v),
   db_erase(C2),
   db_size(people, S2),
   assertion(S2 == 0).

test(db_iterate1, [setup(model_db), N =:= 3]) :-

   findall('.', db_iterate(people, true, _), L),
   length(L, N).

test(db_iterate2, [setup(model_db), N =:= 2]) :-

   findall(O, db_iterate(people, sex(man), O), L),
   length(L, N).

test(db_iterate3, [setup(model_db), fail]) :-

   db_iterate(people, unexisting_name(man_v), _).

test(db_iterate4, [setup(model_db), N =:= 2]) :-

   findall(O, db_iterate(people, functor(man_v), O), L),
   length(L, N).

test(db_iterate5, [setup(model_db), N =:= 3]) :-

   findall(O, db_iterate(people, functor(_), O), L),
   length(L, N).

test(db_iterate6, [setup(model_db), N =:= 3]) :-

   findall(O, db_iterate(people, same_or_descendant(man_v), O), L),
   length(L, N).

test(db_iterate7, [setup(model_db), N =:= 1]) :-

   findall(O, db_iterate(people, same_or_descendant(citizen_v), O), L),
   length(L, N).

test(db_iterate8, [setup(model_db)]) :-

   findall(Surname, db_iterate(people, surname(Surname), _), SL),
   assertion(SL =@= [_, _, 'Mayakovsky']),
   findall(Surname, db_iterate(people, sex(Surname), _), SL2),
   assertion(SL2 == [man, woman, man]).

test(db_iterate9, [setup(model_db), N == 1]) :-

   aggregate_all(count, db_iterate(people, surname(+bound), _), N).

test(db_iterate10, [setup(model_db), N == 2]) :-

   aggregate_all(count, db_iterate(people, surname(+free), _), N).

test(db_iterate11, [setup(model_db)]) :-

   aggregate_all(count,
                 db_iterate(people,
                            surname('Mayakovsky') /\ surname(+free), _),
                 N1),
   assertion(N1 == 0),
   aggregate_all(count,
                 db_iterate(people,
                            surname(+free) /\ surname('Mayakovsky'), _),
                 N2),
   assertion(N2 == 0),
   aggregate_all(count,
                 db_iterate(people,
                            surname(+free) /\ surname(+bound), _),
                 N3),
   assertion(N3 == 0),
   aggregate_all(count,
                 db_iterate(people,
                            surname(+free) \/ surname(+bound), _),
                 N4),
   assertion(N4 == 3),
   aggregate_all(count,
                 db_iterate(people,
                            surname('Mayakovsky') /\ surname(+bound), _),
                 N5),
   assertion(N5 == 1),
   aggregate_all(count,
                 db_iterate(people,
                            surname(+bound) /\ surname('Mayakovsky'), _),
                 N6),
   assertion(N6 == 1).

test(db_to_list, [setup(model_db)]) :-

   db_to_list(people, man_v, L1),
   length(L1, N1),
   assertion(N1 =:= 2),

   db_to_list(people, citizen_v, L2),
   length(L2, N2),
   assertion(N2 =:= 1),

   db_to_list(people, _, L3),
   length(L3, N3),
   assertion(N3 =:= 3).

test(db_put_object1,
     [setup(model_db),
      List == [['Adam'], ['Eva'], ['Moses'], ['Vladimir']]
      ]) :-

   obj_construct(man_v, [name], ['Moses'], Man),
   db_put_object(people, Man),
   db_select_list(people, _, [name], List).

test(db_put_object2, [setup(model_db)]) :-

   obj_construct(man_v, [name], ['Moses'], Man0),
   obj_rebase((object_v -> db_object_v), Man0, Man),
   db_put_object(people, Man).

test(db_put_object3,
     [setup(model_db),
      error(db_obj_replace_protector(people2, _, Man))]) :-

   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man), !,
   db_put_object(people2, Man).

test(db_put_object4, [setup(model_db)]) :-
% replacing

   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_rewrite(Man0, [name], ['Moses'], [_], Man1),
   db_put_object(people2, throw, Man1, Man2, Replaced),
   named_args_unify(Man2,
                    [name, db_key, db_ref],
                    [New_Name, DB_Key, DB_Ref]),
   assertion(New_Name =@= _),
   assertion(Replaced == replaced),
   assertion(nonvar(DB_Ref)),
   assertion(DB_Key == people2),

   db_size(people2, N),
   assertion(N =:= 1).

% replacing rebased
test(db_put_object4_1, [setup(model_db), error(class_parents_mismatch(_,_,_,_))]) :-
   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_rewrite(Man0, [name], ['Moses'], [_], Man1),
   obj_parents(Man1, [man_v, tarjan_vertex_v, db_object_v, object_v, object_base_v], Man2),
   db_put_object(people2, throw, Man2, _, _).

% replacing downcasted
test(db_put_object4_2, [setup(db_clear(people2))]) :-
   db_construct(people2, citizen_v,
                [birthday, sex, name, surname, id],
                [1994, man, l, k, 199442]),
   db_recorded(people2, Man1), !,
   obj_downcast(Man1, callup_v, Man2),
   db_put_object(people2, throw, Man2, Man3, Replaced),
   named_args_unify(Man3,
                    [name, db_key, db_ref],
                    [New_Name, DB_Key, DB_Ref]),
   assertion(New_Name == l),
   assertion(Replaced == replaced),
   assertion(nonvar(DB_Ref)),
   assertion(DB_Key == people2),
   db_size(people2, N),
   assertion(N =:= 1).

% replace with incorrect db_key
test(db_put_object4_3,
     [setup((db_clear(people), db_clear(people2))),
      error(_)]) :-
   db_construct(people, man_v, [name, surname], [1,2], M1),
   db_construct(people2, man_v, [name,surname], [1,2]),
   obj_rewrite(M1, [db_key, deb_ref], [_, _], [people2, _], MM1),
   db_put_object(people, throw, MM1, _, _).

test(db_put_object5,
     [setup(model_db),
      error(domain_error(unbound_db_ref, DB_Ref))]) :-

   db_construct(people, man_v, [name], ['Moses']),
   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_field(Man0, db_ref, DB_Ref),
   db_put_object(people, throw, Man0, _, _).

test(db_put_object6,
     [setup(model_db),
      error(domain_error(unbound_or_same_db_key, people2))]) :-

   db_construct(people, man_v, [name], ['Moses']),
   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_reset_fields([db_ref], Man0, Man),
   db_put_object(people, throw, Man, _, _).

test(db_put_object7,
     [setup(model_db),
      error(db_obj_replace_protector(people2, replaced, Man1))]) :-

   db_construct(people2, man_v, [name], ['Moses']),
   db_recorded(people2, Man0), !,
   obj_rewrite(Man0, [db_ref, name], [_, 'Moses'], [_, _], Man1),
   db_put_object(people2, throw, Man1, _, replaced).
   % does not replace because of unbound db_ref

test(db_put_object8,
     [setup(model_db),
      error(db_obj_replace_protector(people2, replaced, Man))]) :-

   db_construct(people2, man_v, [name], ['Moses']),
   obj_construct(man_v, [name], ['Simeon'], Man),
   db_put_object(people2, _, Man, _, replaced).
   % does not replace because of not db_object_v descendant

test(db_put_object9,
     [blocked(rebase_collision), setup(model_db),
      List == [['Adam'], ['Eva'], ['Moses'], ['Vladimir']]
      ]) :-

   obj_construct(man_v, [name], ['Moses'], Man0),
   obj_rebase((object_v -> db_object_v), Man0, Man1),
   obj_rebase((object_v -> tarjan_vertex_v), Man1, Man),
   db_put_object(people, Man),
   db_select_list(people, _, [name], List).

test(db_recorda1,
     [setup(model_db),
      List == [['Moses'], ['Adam'], ['Eva'], ['Vladimir']]
      ]) :-

   obj_construct(man_v, [name], ['Moses'], Man),
   db_recorda(people, Man),
   db_select_list(people, _, [name], List).

test(db_put_objects,
    [setup(db_clear(people)),
     DB_Size =:= 3]
    ) :-

	maplist(obj_construct(man_v, [name]),
		[['Valera'], ['Vika'], ['Yura']],
		Men),

	db_put_objects(people,
		       Men+\El^member(El, Men),
		       fail),

	db_size(people, DB_Size).

test(db_recorded_bug1, [setup(model_db), N =:= 3]) :-

   findall('.', db_recorded(people, _), L),
   length(L, N).

test(db_recorded1,
     [setup(model_db),
      error(domain_error(db_object_v_descendant, X))]) :-

   obj_construct(man_v, [sex], [man], X),
   db_recorded(people, X).

test(db_recorded2, [setup(model_db)]) :-

   findall('.',
           (obj_construct(man_v, [sex], [man], X0),
            obj_rebase((object_v -> db_object_v), X0, X),
            db_recorded(people, X)),
           L2),
   length(L2, N2),
   assertion(N2 =:= 1).

test(db_recorded3, [setup(model_db)]) :-

   findall('.',
           (obj_construct(man_v, [], [], X0),
            obj_rebase((object_v -> db_object_v), X0, X),
            db_recorded(people, X)),
           L2),
   length(L2, N2),
   assertion(N2 =:= 2).

test(db_recorded4, [setup(model_db)]) :-

   findall('.',
           (obj_construct(man_v, [height], [1.76], X0),
            obj_rebase((object_v -> db_object_v), X0, X),
            db_recorded(people, X)),
           L2),
   length(L2, N2),
   assertion(N2 =:= 2).

test(db_recorded5, [setup(db_clear(people))]) :-

   db_construct(people, man_v, [], []),
   db_recorded(people, X), !,
   db_recorded(people, X).

% test(db_rewrite1,
%      [setup(model_db),
%       List =@= [['Adam', 'Kasperski', 66],
%                 ['Eva', 'Kasperski', 66],
%                 ['Vladimir', 'Kasperski', 66]]
%      ]) :-

%    db_rewrite(people, _,
%               [weight, surname], _, [66, 'Kasperski']),
%    db_select_list(people, _, [name, surname, weight], List).

% test(db_rewrite2,
%      [setup(model_db),
%       List =@= [['Adam', 'Kasperski', 66],
%                 ['Eva', 'Kasperski', 66],
%                 ['Vladimir', 'Mayakovsky', _]]
%      ]) :-

%    db_rewrite(people, man_v,
%               [weight, surname], _, [66, 'Kasperski']),
%    db_select_list(people, _, [name, surname, weight], List).

test(db_search,
     [setup(model_db),
      List == [['Adam'], ['Vladimir']]
     ]) :-

   db_search(people, people2, db_search_pred),
   db_select_list(people2, _, [name], List).

db_search_pred(Man) :-

  obj_field(Man, sex, Sex),
  Sex == man.

test(db_select1,
     [setup(model_db),
      List =@= [[man_v, man, 'Adam', _, 73, _],
                [man_v, woman, 'Eva', _, 64, _],
                [citizen_v, man, 'Vladimir', 'Mayakovsky', _,
                 ['Soviet Union']]]
      ]) :-

   findall(Row,
           db_select(people,
                     [class, sex, name, surname, weight, country],
                     Row),
           List
          ).

test(db_select2,
     [setup(model_db),
      List =@= [[man_v, man, 'Adam', _, 73, _],
                [man_v, woman, 'Eva', _, 64, _]]
      ]) :-

   findall(Row,
           (   Row = [man_v|_],
               db_select(people,
                         [functor, sex, name, surname, weight,
                          country],
                         Row)
           ), List
          ).

test(db_select3,
     [setup((model_db,
      db_construct(people, citizen_v, [id, sex, name, age], [2, man, 'Igor', 19]))),
     Classes == [callup_v]]) :-
   findall(Class, db_select(people,  [name, class], ['Igor', Class]), Classes).

test(db_select_list1,
     [setup(model_db),
      List =@= [[man_v, man, 'Adam', _, 73, _],
                [man_v, woman, 'Eva', _, 64, _],
                [citizen_v, man, 'Vladimir', 'Mayakovsky', _,
                 ['Soviet Union']]]
      ]) :-

   db_select_list(people, _,
                  [class, sex, name, surname, weight, country],
                  List).

test(db_select_list2,
     [setup(model_db),
      List =@= [[man_v, man, 'Adam', _, 73, _],
                [man_v, woman, 'Eva', _, 64, _]]
      ]) :-

   db_select_list(people, man_v, _,
                  [class, sex, name, surname, weight, country],
                  List).

test(db_select_list3,
     [setup(model_db),
      error(no_object_field(_, country))
      ]) :-

   db_select_list(people, man_v, throw,
                  [class, sex, name, surname, weight, country],
                  _).

test(filter_on_db,
     [setup(model_db),
      List = [['Adam'], ['Vladimir']]
     ]) :-

   filter_on_db(people, [sex], [man]),
   db_select_list(people, _, [name], List).

test(named_args_unify1, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, _, [sex], [man], _),
           ['.', '.']).

test(named_args_unify2, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, _, [sex, sex], [man, man], _),
           ['.', '.']).

test(named_args_unify3_eval, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, _, [sex, age], [_, _], _),
           ['.']).

test(named_args_unify_bug1, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, citizen_v, [sex], [man], _),
           ['.']).

test(named_args_unify_bug2, [setup(model_db)]) :-

   findall('.',
           named_args_unify(people, _, [], [], _),
           ['.', '.', '.']).

test(eval_obj_expr1,
     [setup(model_db),
     List == ['Adam', 'Eva', 'Vladimir']]) :-
   findall(Name, @people / name ^= Name, List).

test(eval_obj_expr2, [setup(model_db)]) :-
   findall(Object, ((@people -> Object) / functor ^= citizen_v), Os),
   assertion(Os / surname =^= ['Mayakovsky']).

test(store_and_retrieve1,
    [setup(db_clear(people)),
     man(Sex, Name, Surname, Weight, Height) ==
     man(man, 'Adam', 'Adamov', 1, 3)]
    ) :-

	obj_construct(man_v,
		      [sex, name, surname, weight, height],
		      [man, 'Adam', 'Adamov', 1, 3],
		      Man),

	db_put_object(people, Man, Man1),

	assertion(obj_is_descendant(Man1, db_object_v)),
	assertion(\+ obj_is_descendant(Man1, man_v)),
	assertion(\+ obj_is_descendant(Man, db_object_v)),

	obj_field(Man1, sex, Sex),
	obj_field(Man1, name, Name),
	obj_field(Man1, surname, Surname),
	obj_field(Man1, weight, Weight),
	obj_field(Man1, height, Height).

test(key_rule1,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),
   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']).

test(key_rule2,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v, [], []),
   db_construct(people, man_v, [], []).

test(key_rule3,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v, [name], ['Sergei']),
   db_construct(people, man_v, [], []).

test(key_rule4,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v, [], []),
   db_construct(people, man_v, [name], ['Sergei']).

test(key_rule5, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Sikorsky']).

test(key_rule6,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name], ['Sergei']),

   db_construct(people, man_v,
                [name], ['Sergei']).

test(key_rule7,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name], ['Sergei']),

   db_construct(people, man_v,
                [surname], ['Lodyagin']).

test(key_rule8, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name], ['Sergei']),

   db_construct(people, man_v,
                [name], ['Artem']).

test(key_rule9,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Sysoev']),

   db_construct(people, man_v,
                [name], ['Sergei']).

test(key_rule10,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name], ['Sergei']),

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Sysoev']).

test(key_rule11,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, citizen_v, [], []).

test(key_rule12,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, man_v, [], []).

test(key_rule13,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, man_v, [name], ['James']).

test(key_rule14,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, man_v, [], []),
   db_construct(people, citizen_v, [id], [5]).

test(key_rule15,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, citizen_v, [id], [4]),
   db_construct(people, man_v,
                [name, surname], ['James', 'Crick']).

test(key_rule16,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v, [name], ['James']),
   db_construct(people, citizen_v, [id], [4]).

test(key_test1) :-
   obj_construct(c4_v, [a, b, c], [1, 2, 3], A),
   obj_construct(c4_v, [a, b, c], [1, 20, 30], B),
   key_test2(A, B, allow).

% nearest_keymaster(A) = nearest_keymaster(B)
test(key_test_set1) :-

   key_test(c1_v, c2_v).

% nearest_keymaster(A) is_accessor_off nearest_keymaster(B)
test(key_test_set2) :-

   key_test(c1_v, c3_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c1_v, c4_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c1_v, c5_v), % key(nk(A)) = key(nk(B))
   key_test(c1_v, c6_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c1_v, c7_v). % key(nk(A)) instersect key(nk(B)) = {}

% nearest_keymaster(A) is_desc_off nearest_keymaster(B)
test(key_test_set3) :-

   key_test(c4_v, c1_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c3_v, c1_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c5_v, c1_v), % key(nk(A)) = key(nk(B))
   key_test(c6_v, c1_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c7_v, c1_v). % key(nk(A)) instersect key(nk(B)) = {}

% nk(A) no_parent_relation_to nk(B) /\ key(nk(A, B)) = {}
test(key_test_set4_1) :-

   key_test(c1_v, d2_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c1_v, d3_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c1_v, d4_v), % key(nk(A)) = key(nk(B))
   key_test(c1_v, d5_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c1_v, d6_v). % key(nk(A)) instersect key(nk(B)) = {}

% nk(A) no_parent_relation_to nk(B) /\ key(nk(A, B)) /= {}
test(key_test_set4_2) :-

   key_test(c5_v, e2_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c5_v, e3_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c5_v, e4_v), % key(nk(A)) = key(nk(B))
   key_test(c5_v, e5_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c5_v, e6_v). % key(nk(A)) instersect key(nk(B)) = {}

% nk(A) no_parent_relation_to nk(B) /\ key(nk(A, B)) = key(nk(A))
test(key_test_set4_3) :-

   key_test(c5_v, f2_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(c5_v, f3_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(c5_v, f4_v), % key(nk(A)) = key(nk(B))
   key_test(c5_v, f5_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(c5_v, f6_v). % key(nk(A)) instersect key(nk(B)) = {}

% nk(A) no_parent_relation_to nk(B) /\ key(nk(A, B)) = key(nk(B))
test(key_test_set4_4) :-

   key_test(f3_v, c5_v), % key(nk(A)) is_superset_of key(nk(B))
   key_test(f2_v, c5_v), % key(nk(A)) is_subset_of key(nk(B))
   key_test(f4_v, c5_v), % key(nk(A)) = key(nk(B))
   key_test(f5_v, c5_v), % key(nk(A)) instersect key(nk(B)) /= {}
   key_test(f6_v, c5_v). % key(nk(A)) instersect key(nk(B)) = {}

test(db_properties_v1_overwrite, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),
   db_construct(people, db_properties_v,
                [key_policy], [overwrite]),
   db_construct(people, man_v, [surname], ['Lodyagin']),

   findall([Name, Surname],
           named_args_unify(people, _, [name, surname],
                            [Name, Surname], _),
           List1),
   assertion(List1 =@= [[_, 'Lodyagin']]).

test(db_properties_v2_throw,
     [setup(db_clear(people)),
      error(db_key_exists(people, _, _))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),
   db_construct(people, db_properties_v,
                [key_policy], [overwrite]),
   db_construct(people, man_v, [surname], ['Lodyagin']),
   db_construct(people, db_properties_v,
                [key_policy], [throw]),
   db_construct(people, man_v, [name], ['Sergei']).

test(db_properties_v3_fail_ignore, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin'], Obj1),
   db_construct(people, db_properties_v,
                [key_policy], [fail]),
   \+ db_construct(people, man_v, [surname], ['Lodyagin']),

   named_args_unify(people, db_properties_v, [], _, Singl1), !,
   obj_rewrite(Singl1, [key_policy], [fail], [ignore], Singl2),
   db_put_object(people, _, Singl2, _, replaced),

   db_construct(people, man_v,
                [name, surname, height], ['Sergei', 'Lodyagin',
                1.74], Obj2),

   findall([Name, Surname, Height],
           named_args_unify(people, _,
                            [name, surname, height],
                            [Name, Surname, Height], _),
           List1),
   assertion(List1 =@= [['Sergei', 'Lodyagin', _]]),
   assertion(Obj1 =@= Obj2).

test(db_properties_v4_fail_ignore2, [setup(db_clear(people))]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin'], Obj1),
   db_construct(people, db_properties_v,
                [key_policy], [fail]),
   \+ db_construct(people, man_v, [surname], ['Lodyagin']),

   obj_construct(db_properties_v, [key_policy], [ignore], Singl2),
   db_put_object(people, overwrite, Singl2, _),

   db_construct(people, man_v,
                [name, surname, height], ['Sergei', 'Lodyagin',
                1.74], Obj2),

   findall([Name, Surname, Height],
           named_args_unify(people, _,
                            [name, surname, height],
                            [Name, Surname, Height], _),
           List1),
   assertion(List1 =@= [['Sergei', 'Lodyagin', _]]),
   assertion(Obj1 =@= Obj2).

test(db_properties_v5_invalid_policy,
     [setup(db_clear(people)),
      blocked(need_to_see)
      ]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),
   db_construct(people, db_properties_v,
                [key_policy], [throws]),
   db_construct(people, man_v, [surname], ['Lodyagin']).

test(rebase_collision_bug1, [blocked(rebase_collision)]) :-

   obj_construct(man_v, [], [], O0),
   obj_rebase((object_v -> tarjan_vertex_v), O0, O),
   db_put_object(people, O).

% check default key policy
test(after_put_callback1,
     [setup(callback_setup),
      error(db_key_exists(people, _, _))
     ]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),

   context_module(This),
   db_construct(people, db_properties_v,
                [after_put_callback], [This:after_put_callback]),

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']).

test(after_put_callback2,
     [setup(callback_setup)]) :-

   db_construct(people, man_v,
                [name, surname], ['Sergei', 'Lodyagin']),

   context_module(This),
   db_construct(people, db_properties_v,
                [after_put_callback], [This:after_put_callback], Props),

   db_construct(people, man_v,
                [name, surname], ['Alex', 'Petrenko']),

   obj_rewrite(Props, [key_policy], _, [fail], Props2),
   db_put_object(people, _, Props2, Props3, replaced),
   ignore(db_construct(people, man_v,
                       [name, surname], ['Alex', 'Petrenko'])),

   obj_rewrite(Props3, [after_put_callback], _, [_], Props4),
   db_put_object(people, _, Props4, _, replaced),

   db_construct(people, man_v,
                [name, surname], ['James', 'Petrenko']),

   findall(p(Functor, Name, Surname),
           (  apc(Obj),
              obj_unify(Obj, weak,
                        [functor, name, surname], [Functor, Name, Surname])
           ),
           List),

   assertion(List = [p(db_properties_v, _, _),
                     p(man_v, 'Alex', 'Petrenko'),
                     p(db_properties_v, _, _),
                     p(db_properties_v, _, _),
                     p(man_v, 'James', 'Petrenko')
                     ]).

after_put_callback(Obj) :-

   assertz(apc(Obj)).

callback_setup :-

   db_clear(people),
   retractall(apc(_)).

model_db :-

	db_clear(people),
	db_clear(people2),

        db_construct(people, man_v,
                     [sex, name, weight], [man, 'Adam', 73]),
        db_construct(people, man_v,
                     [sex, name, weight], [woman, 'Eva', 64]),

        db_construct(people, citizen_v,
                      [sex, name, surname, country, id],
                      [man, 'Vladimir', 'Mayakovsky',
                       ['Soviet Union'], 1]).

setup :-

   db_clear(plunit_vd__key_test),
   reload_classes.

reload_classes :-

   current_prolog_flag(verbose, Old_Verbose),
   set_prolog_flag(verbose, silent),
   reload_all_classes,
   set_prolog_flag(verbose, Old_Verbose),
   key_test_classes.

key_test_classes :-

   class_create(c0_v, object_v, [a, b, c], [a]),
   class_create(c1_v, c0_v, [], [b, c]),
   class_create(c2_v, c1_v, [d]),
   class_create(c3_v, c2_v, [], [c]),
   class_create(c4_v, c3_v, [], [a, b, c]),
   class_create(c5_v, c1_v, [], [b, c]),
   class_create(c6_v, c1_v, [d], [c, d]),
   class_create(c7_v, c1_v, [e], [a, e]),

   class_create(d1_v, object_v, [a, b, c], [a]),
   class_create(d2_v, d1_v, [], [b]),
   class_create(d3_v, d1_v, [], [a, b, c]),
   class_create(d4_v, d3_v, [], [b, c]),
   class_create(d5_v, d2_v, [], [a, b]),
   class_create(d6_v, d2_v, [f], [c, f]),

   class_create(e1_v, c0_v, [], [b]),
   class_create(e2_v, e1_v, [], [b]),
   class_create(e3_v, e1_v, [], [a, b, c]),
   class_create(e4_v, e3_v, [], [b, c]),
   class_create(e5_v, e2_v, [], [a, b]),
   class_create(e6_v, e2_v, [g], [c, g]),

   class_create(f1_v, c1_v, [], [a]),
   class_create(f2_v, f1_v, [], [b]),
   class_create(f3_v, f1_v, [], [a, b, c]),
   class_create(f4_v, f3_v, [], [b, c]),
   class_create(f5_v, f2_v, [], [a, b]),
   class_create(f6_v, f2_v, [h, j], [j, h]).

key_pattern(patt(Left, Common, Right)) :-
   L = [free, bound],
   member(Left, L),
   member(Common, L),
   member(Right, L).

key_test(AC, BC) :-
   class_primary_id(AC, Id1),
   class_primary_id(BC, Id2),
   nearest_common_keymaster_int(Id1, Id2, Keymaster_Id),
   forall(
          key_pattern(Patt),
          (   fill_keys(AC, BC, Keymaster_Id, Patt, A, B),
              assertion(key_test2(A, B))
	  )).

% Calculate the result
key_test_result(A, B, allow) :-
   ( obj_key(A, []) ; obj_key(B, [])), !.
key_test_result(A, B, conflict) :-
   arg(1, A, Id1),
   arg(1, B, Id2),
   nearest_common_keymaster_int(Id1, Id2, Keymaster_Id),
   get_key(Keymaster_Id, K_Key),
   K_Key \= [],
   obj_unify(A, K_Key, Value),
   obj_unify(B, K_Key, Value), !.
key_test_result(_, _, allow).

key_test2(A, B) :-
   key_test_result(A, B, Conflict),
   key_test2(A, B, Conflict).

key_test2(A, B, allow) :-
   DB = plunit_vd__key_test,
   db_clear(DB),
   db_put_object(DB, A),
   db_put_object(DB, fail, B, _),
   db_clear(DB),
   db_put_object(DB, B),
   db_put_object(DB, fail, A, _), !.

key_test2(A, B, conflict) :-
   DB = plunit_vd__key_test,
   db_clear(DB),
   db_put_object(DB, A),
   \+ db_put_object(DB, fail, B, _),
   db_clear(DB),
   db_put_object(DB, B),
   \+ db_put_object(DB, fail, A, _).

fill_keys(AC, BC, Keymaster_Id, Patt, A, B) :-
   get_key(Keymaster_Id, Common_Key_Part),
   obj_construct(AC, [], [], A),
   obj_construct(BC, [], [], B),
   fill_key(Patt, Common_Key_Part, A, B).

fill_key(patt(A_Patt, Common_Patt, B_Patt), Common_Key, A, B) :-
   obj_key(A, A_Key),
   obj_unify(A, A_Key, A_Key_Value),
   fill_key(A_Patt, A_Key, A_Key_Value),
   obj_unify(A, Common_Key, Common_Key_Value),
   fill_key(Common_Patt, Common_Key, Common_Key_Value),
   obj_key(B, B_Key),
   obj_unify(B, B_Key, B_Key_Value),
   fill_key(B_Patt, B_Key, B_Key_Value).

fill_key(bound, Key, Key) :- !.
fill_key(half_bound, [K|KT], [K|KVT]) :- !,
   same_length(KT, KVT).
fill_key(free, Key, Key_Value) :-
   same_length(Key, Key_Value).

:- end_tests(vd).


Check gcc version before adding -Wno-pointer-sign

# Copyright 2004-2015 Cray Inc.
# Other additional copyright holders may be indicated within.
#
# The entirety of this work is licensed under the Apache License,
# Version 2.0 (the "License"); you may not use this file except
# in compliance with the License.
#
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

#
# settings for gnu-compatible platforms
#

#
# Tools
#
CXX = g++
CC = gcc

RANLIB = ranlib

#
# General Flags
#

DEBUG_CFLAGS = -g
DEPEND_CFLAGS = -MMD -MP
OPT_CFLAGS = -O3
PROFILE_CFLAGS = -pg
PROFILE_LFLAGS = -pg

ifdef CHPL_GCOV
CFLAGS += -fprofile-arcs -ftest-coverage
LDFLAGS += -fprofile-arcs
endif

#
# Flags for compiler, runtime, and generated code
#
COMP_CFLAGS = $(CFLAGS)
COMP_CFLAGS_NONCHPL = -Wno-error
RUNTIME_CFLAGS = -std=c99 $(CFLAGS)
RUNTIME_GEN_CFLAGS = $(RUNTIME_CFLAGS)
RUNTIME_CXXFLAGS = $(CFLAGS)
RUNTIME_GEN_CXXFLAGS = $(RUNTIME_CXXFLAGS)
GEN_CFLAGS = -std=c99
GEN_STATIC_FLAG = -static
GEN_DYNAMIC_FLAG =
LIB_STATIC_FLAG =
LIB_DYNAMIC_FLAG = -shared
SHARED_LIB_CFLAGS = -fPIC

# Set the target architecture for optimization
ifneq ($(CHPL_MAKE_TARGET_ARCH), none)
ifneq ($(CHPL_MAKE_TARGET_ARCH), unknown)
SPECIALIZE_CFLAGS = -march=$(CHPL_MAKE_TARGET_ARCH)
endif
endif

# Set flag for lax or IEEE floating point
FAST_FLOAT_GEN_CFLAGS = -ffast-math
IEEE_FLOAT_GEN_CFLAGS = -fno-fast-math

ifeq ($(CHPL_MAKE_PLATFORM), darwin)
# build 64-bit binaries when on a 64-bit capable PowerPC
ARCH := $(shell test -x /usr/bin/machine -a `/usr/bin/machine` = ppc970 && echo -arch ppc64)
# -Wa,-q passes control over from the horribly outdated version of as to clang's
#  as this is needed to set things like -march=native or else gcc will generate
#  instructions as can't actually assemble.
RUNTIME_CFLAGS += $(ARCH) -Wa,-q
RUNTIME_CXXFLAGS += $(ARCH) -Wa,-q
# the -D_POSIX_C_SOURCE flag prevents nonstandard functions from polluting the global name space
GEN_CFLAGS += -D_POSIX_C_SOURCE $(ARCH) -Wa,-q
GEN_LFLAGS += $(ARCH)
endif

#ensure that 64 bit binaries are made on AIX
ifeq ($(CHPL_MAKE_PLATFORM), aix)
GEN_CFLAGS += -maix64
RUNTIME_CFLAGS += -maix64
RUNTIME_GEN_CFLAGS += -maix64
GEN_CFLAGS += -maix64
COMP_GEN_LFLAGS += -maix64
endif

#
# query gcc version
#
ifndef GNU_GPP_MAJOR_VERSION
export GNU_GPP_MAJOR_VERSION = $(shell $(CXX) -dumpversion | awk '{split($$1,a,"."); printf("%s", a[1]);}')
endif
ifndef GNU_GPP_MINOR_VERSION
export GNU_GPP_MINOR_VERSION = $(shell $(CXX) -dumpversion | awk '{split($$1,a,"."); printf("%s", a[2]);}')
endif
ifndef GNU_GPP_SUPPORTS_MISSING_DECLS
export GNU_GPP_SUPPORTS_MISSING_DECLS = $(shell test $(GNU_GPP_MAJOR_VERSION) -lt 4 || (test $(GNU_GPP_MAJOR_VERSION) -eq 4 && test $(GNU_GPP_MINOR_VERSION) -le 2); echo "$$?")
endif
ifndef GNU_GPP_SUPPORTS_STRICT_OVERFLOW
export GNU_GPP_SUPPORTS_STRICT_OVERFLOW = $(shell test $(GNU_GPP_MAJOR_VERSION) -lt 4 || (test $(GNU_GPP_MAJOR_VERSION) -eq 4 && test $(GNU_GPP_MINOR_VERSION) -le 2); echo "$$?")
endif

#
# Flags for turning on warnings for C++/C code
#
WARN_CXXFLAGS = -Wall -Werror -Wpointer-arith -Wwrite-strings -Wno-strict-aliasing
# decl-after-stmt for non c99 compilers. See commit message 21665
WARN_CFLAGS = $(WARN_CXXFLAGS) -Wmissing-prototypes -Wstrict-prototypes -Wnested-externs -Wdeclaration-after-statement -Wmissing-format-attribute
WARN_GEN_CFLAGS = $(WARN_CFLAGS) -Wno-unused -Wno-uninitialized

#
# Don't warn for signed pointer issues (ex. c_ptr(c_char) )
#
ifeq ($(shell test $(GNU_GPP_MAJOR_VERSION) -lt 4; echo "$$?"),1)
WARN_GEN_CFLAGS += -Wno-pointer-sign
else

ifeq ($(GNU_GPP_SUPPORTS_MISSING_DECLS),1)
WARN_CXXFLAGS += -Wmissing-declarations
else
WARN_CFLAGS += -Wmissing-declarations
endif

ifeq ($(GNU_GPP_SUPPORTS_STRICT_OVERFLOW),1)
# -Wno-strict-overflow is needed only because the way we code range iteration
# (ChapelRangeBase.chpl:793) generates code which can overflow.
GEN_CFLAGS += -Wno-strict-overflow
# -fstrict-overflow was introduced in GCC 4.2 and is on by default.  When on,
# it allows the compiler to assume that integer sums will not overflow, which
#  can change the programs runtime behavior (when -O2 or greater is tossed).
endif

#
# compiler warnings settings
#
ifeq ($(WARNINGS), 1)
COMP_CFLAGS += $(WARN_CXXFLAGS)
RUNTIME_CFLAGS += $(WARN_CFLAGS) -Wno-char-subscripts
RUNTIME_CXXFLAGS += $(WARN_CXXFLAGS)
RUNTIME_CXXFLAGS += $(WARN_CXXFLAGS)
RUNTIME_GEN_CFLAGS += -Wno-unused
RUNTIME_GEN_CXXFLAGS += -Wno-unused
#WARN_GEN_CFLAGS += -Wunreachable-code
# GEN_CFLAGS gets warnings added via WARN_GEN_CFLAGS in comp-generated Makefile

#
# When compiling GASNet...
#
# -Wno-missing-prototypes must be used because
# gasneti_linkconfig_idiotcheck isn't prototyped before it's used (boo)
# and is static, so we can't prototype it for them (awwww).
#
# -Wno-strict-prototypes has to be used because most GASNet prototypes
# aren't strict.
#
# -Wno-unused has to be used due to _dummy_checkalign variables in
# -gasnet_atomicops.h
#
CHPL_GASNET_MORE_CFLAGS = -Wno-strict-prototypes -Wno-missing-prototypes
ifndef CHPL_COMM_DEBUG
CHPL_GASNET_MORE_CFLAGS += -Wno-unused
endif
endif
ifdef CHPL_COMM_DEBUG
CHPL_GASNET_MORE_CFLAGS += -O0
CHPL_GASNET_MORE_GEN_CFLAGS += -Wno-uninitialized
endif

# Copyright 2004-2015 Cray Inc.
# Other additional copyright holders may be indicated within.
#
# The entirety of this work is licensed under the Apache License,
# Version 2.0 (the "License"); you may not use this file except
# in compliance with the License.
#
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

#
# settings for gnu-compatible platforms
#

#
# Tools
#
CXX = g++
CC = gcc

RANLIB = ranlib

#
# General Flags
#

DEBUG_CFLAGS = -g
DEPEND_CFLAGS = -MMD -MP
OPT_CFLAGS = -O3
PROFILE_CFLAGS = -pg
PROFILE_LFLAGS = -pg

ifdef CHPL_GCOV
CFLAGS += -fprofile-arcs -ftest-coverage
LDFLAGS += -fprofile-arcs
endif

#
# Flags for compiler, runtime, and generated code
#
COMP_CFLAGS = $(CFLAGS)
COMP_CFLAGS_NONCHPL = -Wno-error
RUNTIME_CFLAGS = -std=c99 $(CFLAGS)
RUNTIME_GEN_CFLAGS = $(RUNTIME_CFLAGS)
RUNTIME_CXXFLAGS = $(CFLAGS)
RUNTIME_GEN_CXXFLAGS = $(RUNTIME_CXXFLAGS)
GEN_CFLAGS = -std=c99
GEN_STATIC_FLAG = -static
GEN_DYNAMIC_FLAG =
LIB_STATIC_FLAG =
LIB_DYNAMIC_FLAG = -shared
SHARED_LIB_CFLAGS = -fPIC

# Set the target architecture for optimization
ifneq ($(CHPL_MAKE_TARGET_ARCH), none)
ifneq ($(CHPL_MAKE_TARGET_ARCH), unknown)
SPECIALIZE_CFLAGS = -march=$(CHPL_MAKE_TARGET_ARCH)
endif
endif

# Set flag for lax or IEEE floating point
FAST_FLOAT_GEN_CFLAGS = -ffast-math
IEEE_FLOAT_GEN_CFLAGS = -fno-fast-math

ifeq ($(CHPL_MAKE_PLATFORM), darwin)
# build 64-bit binaries when on a 64-bit capable PowerPC
ARCH := $(shell test -x /usr/bin/machine -a `/usr/bin/machine` = ppc970 && echo -arch ppc64)
# -Wa,-q passes control over from the horribly outdated version of as to clang's
#  as this is needed to set things like -march=native or else gcc will generate
#  instructions as can't actually assemble.
RUNTIME_CFLAGS += $(ARCH) -Wa,-q
RUNTIME_CXXFLAGS += $(ARCH) -Wa,-q
# the -D_POSIX_C_SOURCE flag prevents nonstandard functions from polluting the global name space
GEN_CFLAGS += -D_POSIX_C_SOURCE $(ARCH) -Wa,-q
GEN_LFLAGS += $(ARCH)
endif

#ensure that 64 bit binaries are made on AIX
ifeq ($(CHPL_MAKE_PLATFORM), aix)
GEN_CFLAGS += -maix64
RUNTIME_CFLAGS += -maix64
RUNTIME_GEN_CFLAGS += -maix64
GEN_CFLAGS += -maix64
COMP_GEN_LFLAGS += -maix64
endif

#
# query gcc version
#
ifndef GNU_GPP_MAJOR_VERSION
export GNU_GPP_MAJOR_VERSION = $(shell $(CXX) -dumpversion | awk '{split($$1,a,"."); printf("%s", a[1]);}')
endif
ifndef GNU_GPP_MINOR_VERSION
export GNU_GPP_MINOR_VERSION = $(shell $(CXX) -dumpversion | awk '{split($$1,a,"."); printf("%s", a[2]);}')
endif
ifndef GNU_GPP_SUPPORTS_MISSING_DECLS
export GNU_GPP_SUPPORTS_MISSING_DECLS = $(shell test $(GNU_GPP_MAJOR_VERSION) -lt 4 || (test $(GNU_GPP_MAJOR_VERSION) -eq 4 && test $(GNU_GPP_MINOR_VERSION) -le 2); echo "$$?")
endif
ifndef GNU_GPP_SUPPORTS_STRICT_OVERFLOW
export GNU_GPP_SUPPORTS_STRICT_OVERFLOW = $(shell test $(GNU_GPP_MAJOR_VERSION) -lt 4 || (test $(GNU_GPP_MAJOR_VERSION) -eq 4 && test $(GNU_GPP_MINOR_VERSION) -le 2); echo "$$?")
endif

#
# Flags for turning on warnings for C++/C code
#
WARN_CXXFLAGS = -Wall -Werror -Wpointer-arith -Wwrite-strings -Wno-strict-aliasing
# decl-after-stmt for non c99 compilers. See commit message 21665
WARN_CFLAGS = $(WARN_CXXFLAGS) -Wmissing-prototypes -Wstrict-prototypes -Wnested-externs -Wdeclaration-after-statement -Wmissing-format-attribute
WARN_GEN_CFLAGS = $(WARN_CFLAGS) -Wno-unused -Wno-uninitialized

#
# Don't warn for signed pointer issues (ex. c_ptr(c_char) )
#
WARN_GEN_CFLAGS += -Wno-pointer-sign

ifeq ($(GNU_GPP_SUPPORTS_MISSING_DECLS),1)
WARN_CXXFLAGS += -Wmissing-declarations
else
WARN_CFLAGS += -Wmissing-declarations
endif

ifeq ($(GNU_GPP_SUPPORTS_STRICT_OVERFLOW),1)
# -Wno-strict-overflow is needed only because the way we code range iteration
# (ChapelRangeBase.chpl:793) generates code which can overflow.
GEN_CFLAGS += -Wno-strict-overflow
# -fstrict-overflow was introduced in GCC 4.2 and is on by default.  When on,
# it allows the compiler to assume that integer sums will not overflow, which
#  can change the programs runtime behavior (when -O2 or greater is tossed).
endif

#
# compiler warnings settings
#
ifeq ($(WARNINGS), 1)
COMP_CFLAGS += $(WARN_CXXFLAGS)
RUNTIME_CFLAGS += $(WARN_CFLAGS) -Wno-char-subscripts
RUNTIME_CXXFLAGS += $(WARN_CXXFLAGS)
RUNTIME_CXXFLAGS += $(WARN_CXXFLAGS)
RUNTIME_GEN_CFLAGS += -Wno-unused
RUNTIME_GEN_CXXFLAGS += -Wno-unused
#WARN_GEN_CFLAGS += -Wunreachable-code
# GEN_CFLAGS gets warnings added via WARN_GEN_CFLAGS in comp-generated Makefile

#
# When compiling GASNet...
#
# -Wno-missing-prototypes must be used because
# gasneti_linkconfig_idiotcheck isn't prototyped before it's used (boo)
# and is static, so we can't prototype it for them (awwww).
#
# -Wno-strict-prototypes has to be used because most GASNet prototypes
# aren't strict.
#
# -Wno-unused has to be used due to _dummy_checkalign variables in
# -gasnet_atomicops.h
#
CHPL_GASNET_MORE_CFLAGS = -Wno-strict-prototypes -Wno-missing-prototypes
ifndef CHPL_COMM_DEBUG
CHPL_GASNET_MORE_CFLAGS += -Wno-unused
endif
endif
ifdef CHPL_COMM_DEBUG
CHPL_GASNET_MORE_CFLAGS += -O0
CHPL_GASNET_MORE_GEN_CFLAGS += -Wno-uninitialized
endif


Test for find_all.

Test for find_all.

:- include(misc(common)).

:- use_module(bson(bson), []).
:- use_module(misc(util), []).

up(Conn, Coll) :-
    mongo:new(Conn),
    mongo:get_database(Conn, 'prolongo', Db),
    mongo:get_collection(Db, 'testcoll', Coll).

down(Conn) :-
    mongo:free(Conn).

:- begin_tests('mongo:update/4').

test('update normal', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    mongo:delete(Coll, [hello-me]),
    mongo:insert(Coll, [hello-world]),
    mongo:update(Coll, [hello-world], [hello-me]),
    mongo:find_one(Coll, [hello-me], Doc),
    bson:doc_get(Doc, hello, me).

:- end_tests('mongo:update/4').

:- begin_tests('mongo:update/5').

test('update upsert', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    mongo:delete(Coll, [hello-me]),
    mongo:update(Coll, [hello-world], [hello-me], [upsert]),
    mongo:find_one(Coll, [hello-me], Doc),
    bson:doc_get(Doc, hello, me).

test('update multi', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    mongo:delete(Coll, [hello-me]),
    mongo:insert(Coll, [hello-world,num-1]),
    mongo:insert(Coll, [hello-world,num-2]),
    mongo:insert(Coll, [hello-world,num-3]),
    mongo:update(Coll, [hello-world], ['$inc'-[num-10]], [multi]),
    mongo:find(Coll, [hello-world], [], 0, 3, _Cursor, [Doc1,Doc2,Doc3]),
    % XXX Maybe this sort order is not guaranteed?
    bson:doc_get(Doc1, num, 11),
    bson:doc_get(Doc2, num, 12),
    bson:doc_get(Doc3, num, 13).

:- end_tests('mongo:update/5').

:- begin_tests('mongo:delete/3').

test('delete', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:insert(Coll, [hello-world]),
    mongo:find(Coll, [hello-world], [], 0, 0, _Cursor1, [_|_]),
    mongo:delete(Coll, [hello-world]),
    mongo:find(Coll, [hello-world], [], 0, 0, _Cursor2, []).

:- end_tests('mongo:delete/3').

:- begin_tests('mongo:find/8').

test('cursor', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    mongo:insert(Coll, [hello-world,number-1]),
    mongo:insert(Coll, [hello-world,number-2]),
    mongo:insert(Coll, [hello-world,number-3]),
    mongo:insert(Coll, [hello-world,number-4]),
    mongo:insert(Coll, [hello-world,number-5]),
    mongo:insert(Coll, [hello-world,number-6]),
    mongo:insert(Coll, [hello-world,number-7]),
    mongo:insert(Coll, [hello-world,number-8]),
    mongo:insert(Coll, [hello-world,number-9]),
    mongo:find(Coll, [hello-world], [number-1], 3, 3, Cursor0, Docs0),
    Docs0 =
    [
        ['_id'-object_id(_),number-_],
        ['_id'-object_id(_),number-_],
        ['_id'-object_id(_),number-_]
    ],
    mongo:has_more(Cursor0),
    mongo:get_more(Cursor0, 3, Docs1, Cursor1),
    Docs1 =
    [
        ['_id'-object_id(_),number-_],
        ['_id'-object_id(_),number-_],
        ['_id'-object_id(_),number-_]
    ],
    mongo:has_more(Cursor1),
    mongo:get_more(Cursor1, 3, Docs2, Cursor2),
    Docs2 =
    [
    ],
    \+ mongo:has_more(Cursor2).

test('insert many single, cursor exhaust', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    insert_n_docs(Coll, 1000),
    mongo:find(Coll, [hello-world], [number-1], 0, 0, Cursor, Docs0),
    mongo:exhaust(Cursor, DocsRest),
    lists:length(Docs0, N0),
    lists:length(DocsRest, N),
    1000 is N0 + N.

insert_n_docs(_Coll, 0) :- !.
insert_n_docs(Coll, N) :-
    mongo:insert(Coll, [hello-world,number-N]),
    N1 is N - 1,
    insert_n_docs(Coll, N1).

test('insert batch, cursor exhaust', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    create_n_docs(1000, Docs),
    mongo:insert_batch(Coll, [], Docs),
    mongo:find(Coll, [hello-world], [number-1], 0, 0, Cursor, Docs0),
    mongo:exhaust(Cursor, DocsRest),
    lists:length(Docs0, N0),
    lists:length(DocsRest, N),
    1000 is N0 + N.

create_n_docs(0, []) :- !.
create_n_docs(N, [[hello-world,number-N]|Docs]) :-
    N1 is N - 1,
    create_n_docs(N1, Docs).

test('insert batch, find_all', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    create_n_docs(1000, Docs),
    mongo:insert_batch(Coll, [], Docs),
    mongo:find_all(Coll, [hello-world], [number-1], DocsAll),
    lists:length(DocsAll, 1000).

:- end_tests('mongo:find/8').

:- begin_tests('mongo:find_one/4,5').

test('entire doc', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    Doc = [hello-world, number-42],
    mongo:insert(Coll, Doc),
    mongo:find_one(Coll, Doc, Doc1),
    bson:doc_get(Doc1, number, 42).

test('entire doc', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    Doc = [hello-world, number-42],
    mongo:insert(Coll, Doc),
    mongo:find_one(Coll, Doc, Doc1),
    bson:doc_get(Doc1, number, 42).

test('return fields selector', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    Doc = [hello-world, number-42],
    mongo:insert(Coll, Doc),
    Fields = [number-1],
    mongo:find_one(Coll, Doc, Fields, Doc1),
    bson:doc_get(Doc1, '_id', object_id(_)), % Always returned.
    bson:doc_get(Doc1, number, 42),
    \+ bson:doc_get(Doc1, hello, world).

:- end_tests('mongo:find_one/4,5').

:- begin_tests('mongo:insert/3').

test('insert', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    util:ms_since_epoch(MilliSeconds),
    Doc =
    [
        hello - [åäö,5.05],
        now   - utc(MilliSeconds)
    ],
    mongo:insert(Coll, Doc).

:- end_tests('mongo:insert/3').

/*
:- begin_tests('mongo:command/3').

test('list database infos', [setup(up(Mongo)),cleanup(down(Mongo))]) :-
    mongo:list_database_infos(Mongo, DatabaseInfos),
    database(Database),
    bson:doc_get(DatabaseInfos, Database, Info),
    Info \== +null.
    %bson_format:pp(DatabaseInfos), nl.

test('list database names', [setup(up(Mongo)),cleanup(down(Mongo))]) :-
    mongo:list_database_names(Mongo, DatabaseNames),
    database(Database),
    core:memberchk(Database, DatabaseNames).

% XXX this works now, but I need to fix cursors (only one is shown).
test('list collection names', [setup(up(Mongo)),cleanup(down(Mongo))]) :-
    mongo:list_collection_names(Mongo, Result),
    bson_format:pp(Result).

test('drop collection',
[
    setup(up(Mongo)),
    cleanup(down(Mongo))
]) :-
    collection(Collection),
    mongo:drop_collection(Mongo, Collection, Result),
    write(Result), nl,
    mongo:doc_ok(Result).

% Takes a bit too long when MongoDB reallocates the collection later.
test('drop database', [setup(up(Mongo)),cleanup(down(Mongo))]) :-
    database(Database),
    mongo:drop_database(Mongo, Database, Result),
    bson:doc_get(Result, ok, 1.0).

:- end_tests('mongo:command/3').
*/

:- include(misc(common)).

:- use_module(bson(bson), []).
:- use_module(misc(util), []).

up(Conn, Coll) :-
    mongo:new(Conn),
    mongo:get_database(Conn, 'prolongo', Db),
    mongo:get_collection(Db, 'testcoll', Coll).

down(Conn) :-
    mongo:free(Conn).

:- begin_tests('mongo:update/4').

test('update normal', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    mongo:delete(Coll, [hello-me]),
    mongo:insert(Coll, [hello-world]),
    mongo:update(Coll, [hello-world], [hello-me]),
    mongo:find_one(Coll, [hello-me], Doc),
    bson:doc_get(Doc, hello, me).

:- end_tests('mongo:update/4').

:- begin_tests('mongo:update/5').

test('update upsert', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    mongo:delete(Coll, [hello-me]),
    mongo:update(Coll, [hello-world], [hello-me], [upsert]),
    mongo:find_one(Coll, [hello-me], Doc),
    bson:doc_get(Doc, hello, me).

test('update multi', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    mongo:delete(Coll, [hello-me]),
    mongo:insert(Coll, [hello-world,num-1]),
    mongo:insert(Coll, [hello-world,num-2]),
    mongo:insert(Coll, [hello-world,num-3]),
    mongo:update(Coll, [hello-world], ['$inc'-[num-10]], [multi]),
    mongo:find(Coll, [hello-world], [], 0, 3, _Cursor, [Doc1,Doc2,Doc3]),
    % XXX Maybe this sort order is not guaranteed?
    bson:doc_get(Doc1, num, 11),
    bson:doc_get(Doc2, num, 12),
    bson:doc_get(Doc3, num, 13).

:- end_tests('mongo:update/5').

:- begin_tests('mongo:delete/3').

test('delete', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:insert(Coll, [hello-world]),
    mongo:find(Coll, [hello-world], [], 0, 0, _Cursor1, [_|_]),
    mongo:delete(Coll, [hello-world]),
    mongo:find(Coll, [hello-world], [], 0, 0, _Cursor2, []).

:- end_tests('mongo:delete/3').

:- begin_tests('mongo:find/8').

test('cursor', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    mongo:insert(Coll, [hello-world,number-1]),
    mongo:insert(Coll, [hello-world,number-2]),
    mongo:insert(Coll, [hello-world,number-3]),
    mongo:insert(Coll, [hello-world,number-4]),
    mongo:insert(Coll, [hello-world,number-5]),
    mongo:insert(Coll, [hello-world,number-6]),
    mongo:insert(Coll, [hello-world,number-7]),
    mongo:insert(Coll, [hello-world,number-8]),
    mongo:insert(Coll, [hello-world,number-9]),
    mongo:find(Coll, [hello-world], [number-1], 3, 3, Cursor0, Docs0),
    Docs0 =
    [
        ['_id'-object_id(_),number-_],
        ['_id'-object_id(_),number-_],
        ['_id'-object_id(_),number-_]
    ],
    mongo:has_more(Cursor0),
    mongo:get_more(Cursor0, 3, Docs1, Cursor1),
    Docs1 =
    [
        ['_id'-object_id(_),number-_],
        ['_id'-object_id(_),number-_],
        ['_id'-object_id(_),number-_]
    ],
    mongo:has_more(Cursor1),
    mongo:get_more(Cursor1, 3, Docs2, Cursor2),
    Docs2 =
    [
    ],
    \+ mongo:has_more(Cursor2).

test('insert many single, cursor exhaust', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    insert_n_docs(Coll, 1000),
    mongo:find(Coll, [hello-world], [number-1], 0, 0, Cursor, Docs0),
    mongo:exhaust(Cursor, DocsRest),
    lists:length(Docs0, N0),
    lists:length(DocsRest, N),
    1000 is N0 + N.

insert_n_docs(_Coll, 0) :- !.
insert_n_docs(Coll, N) :-
    mongo:insert(Coll, [hello-world,number-N]),
    N1 is N - 1,
    insert_n_docs(Coll, N1).

test('insert batch, cursor exhaust', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    mongo:delete(Coll, [hello-world]),
    create_n_docs(1000, Docs),
    mongo:insert_batch(Coll, [], Docs),
    mongo:find(Coll, [hello-world], [number-1], 0, 0, Cursor, Docs0),
    mongo:exhaust(Cursor, DocsRest),
    lists:length(Docs0, N0),
    lists:length(DocsRest, N),
    1000 is N0 + N.

create_n_docs(0, []) :- !.
create_n_docs(N, [[hello-world,number-N]|Docs]) :-
    N1 is N - 1,
    create_n_docs(N1, Docs).

:- end_tests('mongo:find/8').

:- begin_tests('mongo:find_one/4,5').

test('entire doc', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    Doc = [hello-world, number-42],
    mongo:insert(Coll, Doc),
    mongo:find_one(Coll, Doc, Doc1),
    bson:doc_get(Doc1, number, 42).

test('entire doc', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    Doc = [hello-world, number-42],
    mongo:insert(Coll, Doc),
    mongo:find_one(Coll, Doc, Doc1),
    bson:doc_get(Doc1, number, 42).

test('return fields selector', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    Doc = [hello-world, number-42],
    mongo:insert(Coll, Doc),
    Fields = [number-1],
    mongo:find_one(Coll, Doc, Fields, Doc1),
    bson:doc_get(Doc1, '_id', object_id(_)), % Always returned.
    bson:doc_get(Doc1, number, 42),
    \+ bson:doc_get(Doc1, hello, world).

:- end_tests('mongo:find_one/4,5').

:- begin_tests('mongo:insert/3').

test('insert', [setup(up(Conn,Coll)),cleanup(down(Conn))]) :-
    util:ms_since_epoch(MilliSeconds),
    Doc =
    [
        hello - [åäö,5.05],
        now   - utc(MilliSeconds)
    ],
    mongo:insert(Coll, Doc).

:- end_tests('mongo:insert/3').

/*
:- begin_tests('mongo:command/3').

test('list database infos', [setup(up(Mongo)),cleanup(down(Mongo))]) :-
    mongo:list_database_infos(Mongo, DatabaseInfos),
    database(Database),
    bson:doc_get(DatabaseInfos, Database, Info),
    Info \== +null.
    %bson_format:pp(DatabaseInfos), nl.

test('list database names', [setup(up(Mongo)),cleanup(down(Mongo))]) :-
    mongo:list_database_names(Mongo, DatabaseNames),
    database(Database),
    core:memberchk(Database, DatabaseNames).

% XXX this works now, but I need to fix cursors (only one is shown).
test('list collection names', [setup(up(Mongo)),cleanup(down(Mongo))]) :-
    mongo:list_collection_names(Mongo, Result),
    bson_format:pp(Result).

test('drop collection',
[
    setup(up(Mongo)),
    cleanup(down(Mongo))
]) :-
    collection(Collection),
    mongo:drop_collection(Mongo, Collection, Result),
    write(Result), nl,
    mongo:doc_ok(Result).

% Takes a bit too long when MongoDB reallocates the collection later.
test('drop database', [setup(up(Mongo)),cleanup(down(Mongo))]) :-
    database(Database),
    mongo:drop_database(Mongo, Database, Result),
    bson:doc_get(Result, ok, 1.0).

:- end_tests('mongo:command/3').
*/