The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

## # 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');
    }
}