## # Checking how 'unique' works for second level objects. The trick with # them is that the field should be unique in the space of an enclosing # container, but two containers can have identical properties. # sub test_unique_2 { my $self=shift; my $odb=$self->get_odb();
my $list=$odb->fetch('/Customers');
my $c1=$list->get('c1');
my $c2=$list->get('c2');
$c1->add_placeholder(
name => 'Orders',
type => 'list',
class => 'Data::Order',
key => 'order_id',
);
my $c1list=$c1->get('Orders');
my $c2list=$c2->get('Orders');
my $order=$c1->get('Orders')->get_new;
foreach my $type (qw(text integer real)) {
$order->add_placeholder(
name => 'foo',
type => $type,
unique => 1,
);
$order->put(foo => 1);
my $mistake;
stderr_stop();
try {
$c1list->put(o1 => $order);
$c2list->put(o1 => $order);
$mistake=0;
}
otherwise {
$mistake=1;
};
stderr_restore();
$self->assert(! $mistake,
"Can't put the same object into two different parents' lists");
stderr_stop();
try {
$c1list->put(o2 => $order);
$mistake=1;
}
otherwise {
$mistake=0;
};
stderr_restore();
$self->assert(! $mistake,
"Put the same object twice (type=$type), 'unique' does not work on the second level");
$order->put(foo => 2);
$c2list->put(o2 => $order);
stderr_stop();
try {
$c2list->put(o1 => $order);
$mistake=1;
} otherwise {
$mistake=0;
};
stderr_restore();
$self->assert(! $mistake,
"Put the same object twice (type=$type), replacement");
$self->assert(! $c1list->exists('o2'),
"Got o2 from the c1list");
$self->assert($c1list->get('o1')->get('foo') eq '1',
"Got wrong value from c1list");
$self->assert($c2list->get('o1')->get('foo') eq '1',
"Got wrong value from c2list/o2");
$self->assert($c2list->get('o2')->get('foo') eq '2',
"Got wrong value from c2list/o2");
$order->drop_placeholder('foo');
}
}