#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Exception;
use Try::Tiny;

use Scalar::Util qw(weaken isweak);
use Storable qw(dclone);

use ok 'KiokuDB::Entry';
use ok 'KiokuDB::Collapser';
use ok 'KiokuDB::LiveObjects';
use ok 'KiokuDB::TypeMap';
use ok 'KiokuDB::TypeMap::Resolver';
use ok 'KiokuDB::TypeMap::Entry::MOP';
use ok 'KiokuDB::TypeMap::Entry::Callback';
use ok 'KiokuDB::TypeMap::Entry::Ref';
use ok 'KiokuDB::Backend::Hash';

sub KiokuDB::Entry::BUILD { shift->root }; # force building of root for is_deeply
$_->make_mutable, $_->make_immutable for KiokuDB::Entry->meta; # recreate new


use Tie::RefHash;

sub unknown_ok (&@) {
    my ( $block, @objects ) = @_;

    local $@ = "";
    try {
        $block->();
        fail("should have died");
    } catch {
        is_deeply( $_, KiokuDB::Error::UnknownObjects->new( objects => \@objects), "correct error" );
    };
}

{
    package KiokuDB_Test_Foo;
    use Moose;

    # check reserved field clashes
    has id => ( is => "rw" );

    has bar => ( is => "rw" );

    has zot => ( is => "rw" );

    has moof => ( is => "rw" );

    __PACKAGE__->meta->make_immutable;

    package KiokuDB_Test_Bar;
    use Moose;

    has id => ( is => "rw", isa => "Int" );

    has blah => ( is  => "rw" );

    package KiokuDB_Test_Baz;
    use Moose;

    with qw(KiokuDB::Role::ID);

    has id => ( isa => "Str", is => "ro", required => 1 );

    sub kiokudb_object_id { shift->id }

    package KiokuDB_Test_Quxx;
    use Moose;

    extends qw(KiokuDB_Test_Baz);

    with qw(KiokuDB::Role::ID::Content);
}

{
    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    my $foo = KiokuDB_Test_Foo->new(
        id  => "oink",
        zot => "zot",
        bar => KiokuDB_Test_Bar->new(
            id => 3,
            blah => {
                oink => 3
            },
        ),
    );
 
    unknown_ok { $v->collapse( objects => [ $foo ], only_known => 1 ) } $foo;

    {
        my $obj = KiokuDB_Test_Foo->new( bar => $foo->bar );

        $v->live_objects->insert( foo => $obj );

        unknown_ok { $v->collapse( objects => [ $obj ], only_known => 1 ) } $foo->bar;
    }

    $v->live_objects->insert( bar => $foo->bar );

    unknown_ok { $v->collapse( objects => [ $foo ], only_known => 1 ) } $foo;

    lives_ok {
        my ( $buffer ) = $v->collapse( objects => [ $foo->bar ], only_known => 1 );
        isa_ok( $buffer, "KiokuDB::Collapser::Buffer" );
        is( scalar(values %{ $buffer->_entries }), 1, "one entry for known obj collapse" );
    };

    my ( $buffer, $id, @rest ) = $v->collapse( objects => [ $foo ] );

    ok( $id, "got an id" );

    is( scalar(@rest), 0, "no other return values" );

    my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries;

    my $other_id = $entries[1]->id;

    is( scalar(@entries), 2, "two entries" );

    is( $entries[0]->class, 'KiokuDB_Test_Foo', "class" );

    is_deeply(
        $entries[0]->data,
        {
            bar => KiokuDB::Reference->new( id => $other_id ),
            id  => "oink",
            zot => "zot",
        },
        "KiokuDB_Test_Foo object",
    );

    is_deeply(
        $entries[1]->data,
        {
            id => 3,
            blah => {
                oink => 3
            },
        },
        "KiokuDB_Test_Bar object",
    );
}

{
    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    my $x = { name => "shared" };

    # shared values must be assigned a UID
    my $bar = KiokuDB_Test_Bar->new(
        id => 5,
        blah => [ $x, $x ],
    );

    my ( $buffer, $id ) = $v->collapse( objects => [ $bar ] );

    my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries;

    is( scalar(@entries), 2, "two entries" );

    my $other_id = $entries[1]->id;

    is_deeply(
        $entries[0]->data,
        {
            id => 5,
            blah => [
                KiokuDB::Reference->new( id => $other_id ),
                KiokuDB::Reference->new( id => $other_id ),
            ],
        },
        "parent object",
    );

    is_deeply(
        $entries[1]->data,
        {
            name => "shared",
        },
        "shared ref",
    );
}

{
    # circular ref
    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    my $foo = KiokuDB_Test_Foo->new(
        id  => "oink",
        zot => "zot",
        bar => KiokuDB_Test_Bar->new(
            id => 3,
        ),
    );

    $foo->bar->blah($foo);

    my ( $buffer, $id ) = $v->collapse( objects => [ $foo ] );

    my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries;

    is( scalar(@entries), 2, "two entries" );

    my $other_id = $entries[1]->id;

    is( $entries[0]->class, 'KiokuDB_Test_Foo', "class" );

    is_deeply(
        $entries[0]->data,
        {
            bar => KiokuDB::Reference->new( id => $other_id ),
            id  => "oink",
            zot => "zot",
        },
        "KiokuDB_Test_Foo object",
    );

    is_deeply(
        $entries[1]->data,
        {
            id => 3,
            blah => KiokuDB::Reference->new( id => $id ),
        },
        "KiokuDB_Test_Bar object",
    );
}

{
    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    my $x = { name => "shared" };

    # shared values must be assigned a UID
    my $bar = KiokuDB_Test_Bar->new(
        id => 5,
        blah => [ $x, $x ],
    );

    weaken($bar->blah->[0]);

    my ( $buffer, $id ) = $v->collapse( objects => [ $bar ] );

    my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries;

    is( scalar(@entries), 2, "two entries" );

    my $other_id = $entries[1]->id;

    is_deeply(
        $entries[0]->data,
        {
            id => 5,
            blah => [
                KiokuDB::Reference->new( id => $other_id, is_weak => 1 ),
                KiokuDB::Reference->new( id => $other_id ),
            ],
        },
        "parent object",
    );

    is_deeply(
        $entries[1]->data,
        {
            name => "shared",
        },
        "shared ref",
    );
}

{
    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    my $x = { name => "shared" };

    # shared values must be assigned a UID
    my $bar = KiokuDB_Test_Bar->new(
        id => 5,
        blah => [ $x, $x ],
    );

    # second one is weak
    weaken($bar->blah->[1]);

    my ( $buffer, $id ) = $v->collapse( objects => [ $bar ] );

    my @entries = sort { $a->id eq $id ? -1 : 1 } $buffer->entries;

    is( scalar(@entries), 2, "two entries" );

    my $other_id = $entries[1]->id;

    is_deeply(
        $entries[0]->data,
        {
            id => 5,
            blah => [
                KiokuDB::Reference->new( id => $other_id ),
                KiokuDB::Reference->new( id => $other_id, is_weak => 1 ),
            ],
        },
        "parent object",
    );

    is_deeply(
        $entries[1]->data,
        {
            name => "shared",
        },
        "shared ref",
    );
}

{
    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    my $data = { };
    $data->{self} = $data;

    my $obj = KiokuDB_Test_Foo->new( bar => $data );

    $v->live_objects->insert( obj => $obj );

    unknown_ok { $v->collapse( objects => [ $obj ], only_known => 1 ) } $data;
}

{
    my $obj = KiokuDB_Test_Foo->new( bar => { foo => "hello" } );

    {
        my $v = KiokuDB::Collapser->new(
            backend => KiokuDB::Backend::Hash->new,
            live_objects => my $lo = KiokuDB::LiveObjects->new,
            compact => 0,
            typemap_resolver => KiokuDB::TypeMap::Resolver->new(
                typemap => KiokuDB::TypeMap->new(
                    entries => {
                        ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                        HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                    },
                ),
            ),
        );

        my $s = $lo->new_scope;

        my ( $buffer ) = $v->collapse( objects => [ $obj ] );
        is( scalar(keys %{ $buffer->_entries }), 2, "two entries" );
    }

    {
        my $v = KiokuDB::Collapser->new(
            backend => KiokuDB::Backend::Hash->new,
            live_objects => my $lo = KiokuDB::LiveObjects->new,
            compact => 1,
            typemap_resolver => KiokuDB::TypeMap::Resolver->new(
                typemap => KiokuDB::TypeMap->new(
                    entries => {
                        ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                        HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                    },
                ),
            ),
        );

        my $s = $lo->new_scope;

        my ( $buffer ) = $v->collapse( objects => [ $obj ] );
        is( scalar(keys %{ $buffer->_entries }), 1, "one entry with compacter" );
    }
}

{
    my $obj = KiokuDB_Test_Foo->new( foo => "one", bar => KiokuDB_Test_Foo->new( foo => "two" ) );

    {
        my $v = KiokuDB::Collapser->new(
            backend => KiokuDB::Backend::Hash->new,
            live_objects => my $lo = KiokuDB::LiveObjects->new,
            typemap_resolver => KiokuDB::TypeMap::Resolver->new(
                typemap => KiokuDB::TypeMap->new(
                    entries => {
                        ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                        HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                    },
                ),
            ),
        );

        my $s = $lo->new_scope;

        {
            my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] );
            is( scalar(keys %{ $buffer->_entries }), 2, "two entries for deep collapse" );
            is( scalar(@ids), 1, "one root set ID" );

            $buffer->update_entries( in_storage => 1 );
        }

        {
            my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ], shallow => 1 );
            is( scalar(keys %{ $buffer->_entries }), 1, "one entry for shallow collapse" );
            is( scalar(@ids), 1, "one root set ID" );

            $buffer->update_entries( in_storage => 1 );
        }
    }
}

{
    my $obj = KiokuDB_Test_Foo->new(
        zot => "one",
        bar => KiokuDB_Test_Bar->new( blah => "two" )
    );

    {
        my $v = KiokuDB::Collapser->new(
            backend => KiokuDB::Backend::Hash->new,
            live_objects => my $lo = KiokuDB::LiveObjects->new,
            typemap_resolver => KiokuDB::TypeMap::Resolver->new(
                typemap => KiokuDB::TypeMap->new(
                    entries => {
                        KiokuDB_Test_Bar => KiokuDB::TypeMap::Entry::MOP->new(
                            intrinsic => 1,
                        ),
                        ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                        HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                    },
                ),
            ),
        );

        my $s = $lo->new_scope;

        my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] );

        my $entries = $buffer->_entries;

        is( scalar(keys %$entries), 1, "one entries for deep collapse with intrinsic value" );
        is( scalar(@ids), 1, "one root set ID" );

        is_deeply(
            $entries->{$ids[0]}->data,
            {
                zot => "one",
                bar => KiokuDB::Entry->new(
                    class => "KiokuDB_Test_Bar",
                    data  => { blah => "two" },
                    object => $obj->bar,
                ),
            },
            "intrinsic entry data",
        );
    }
}

{
    my $bar = KiokuDB_Test_Bar->new( blah => "two" );
    my $obj = KiokuDB_Test_Foo->new(
        zot => "one",
        bar => $bar,
        zot => $bar,
    );

    {
        my $v = KiokuDB::Collapser->new(
            backend => KiokuDB::Backend::Hash->new,
            live_objects => my $lo = KiokuDB::LiveObjects->new,
            typemap_resolver => KiokuDB::TypeMap::Resolver->new(
                typemap => KiokuDB::TypeMap->new(
                    entries => {
                        KiokuDB_Test_Bar => KiokuDB::TypeMap::Entry::MOP->new(
                            intrinsic => 1,
                        ),
                        ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                        HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                    },
                ),
            ),
        );

        my $s = $lo->new_scope;

        my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] );

        my $entries = $buffer->_entries;

        is( scalar(keys %$entries), 1, "one entries for deep collapse with shared intrinsic value" );
        is( scalar(@ids), 1, "one root set ID" );

        is_deeply(
            $entries->{$ids[0]}->data,
            {
                zot => "one",
                bar => KiokuDB::Entry->new(
                    class => "KiokuDB_Test_Bar",
                    data  => { blah => "two" },
                    object => $obj->bar,
                ),
                zot => KiokuDB::Entry->new(
                    class => "KiokuDB_Test_Bar",
                    data  => { blah => "two" },
                    object => $obj->bar,
                ),
            },
            "intrinsic entry data",
        );
    }
}

{
    tie my %h, 'Tie::RefHash';

    $h{KiokuDB_Test_Bar->new( blah => "two" )} = "bar";

    my $obj = KiokuDB_Test_Foo->new(
        bar => \%h,
    );

    {
        my $v = KiokuDB::Collapser->new(
            backend => KiokuDB::Backend::Hash->new,
            live_objects => my $lo = KiokuDB::LiveObjects->new,
            typemap_resolver => KiokuDB::TypeMap::Resolver->new(
                typemap => KiokuDB::TypeMap->new(
                    entries => {
                        'Tie::RefHash' => KiokuDB::TypeMap::Entry::Callback->new(
                            intrinsic => 1,
                            collapse  => "STORABLE_freeze",
                            expand    => sub {
                                my ( $class, @args ) = @_;
                                my $self = bless [], $class;
                                $self->STORABLE_thaw(@args);
                                return $self;
                            }
                        ),
                        ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                        HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                    },
                ),
            ),
        );

        my $s = $lo->new_scope;

        my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] );
        is( scalar(@ids), 1, "one root set ID" );

        my $entries = $buffer->_entries;
        my $root = delete $entries->{$ids[0]};
        my $key  = (values %$entries)[0];

        my $t = Tie::RefHash->TIEHASH( KiokuDB::Reference->new( id => $key->id ) => "bar" );

        is_deeply(
            dclone($root),
            KiokuDB::Entry->new(
                id    => $ids[0],
                class => "KiokuDB_Test_Foo",
                data  => {
                    bar => KiokuDB::Entry->new(
                        tied => "H",
                        data => KiokuDB::Entry->new(
                            class => "Tie::RefHash",
                            data  => [ $t->STORABLE_freeze ],
                        ),
                    ),
                },
            ),
            "intrinsic collapsing of Tie::RefHash",
        );
    }
}

{
    tie my %h, 'Tie::RefHash';

    $h{KiokuDB_Test_Bar->new( blah => "two" )} = "bar";

    my $obj = KiokuDB_Test_Foo->new(
        bar => \%h,
    );

    {
        my $v = KiokuDB::Collapser->new(
            backend => KiokuDB::Backend::Hash->new,
            live_objects => my $lo = KiokuDB::LiveObjects->new,
            typemap_resolver => KiokuDB::TypeMap::Resolver->new(
                typemap => KiokuDB::TypeMap->new(
                    entries => {
                        'Tie::RefHash' => KiokuDB::TypeMap::Entry::Callback->new(
                            collapse  => "STORABLE_freeze",
                            expand    => "STORABLE_thaw",
                        ),
                        ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                        HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                    },
                ),
            ),
        );

        my $s = $lo->new_scope;

        my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] );
        is( scalar(@ids), 1, "one root set ID" );

        my $entries = $buffer->_entries;

        my $root = $entries->{$ids[0]};
        my $tie  = (grep { $_->class eq 'Tie::RefHash' } values %$entries)[0];

        is_deeply(
            dclone($root),
            KiokuDB::Entry->new(
                id    => $ids[0],
                class => "KiokuDB_Test_Foo",
                data  => {
                    bar => KiokuDB::Entry->new(
                        tied => "H",
                        data => KiokuDB::Reference->new( id => $tie->id ),
                    ),
                },
            ),
            "first class collapsing of Tie::RefHash",
        );
    }
}

{
    my $bar = KiokuDB_Test_Bar->new( blah => "shared" );

    my $foo_1 = KiokuDB_Test_Foo->new(
        zot => "one",
        bar => $bar,
    );

    my $foo_2 = KiokuDB_Test_Foo->new(
        zot => "two",
        bar => $bar,
    );

    my $foo_3 = KiokuDB_Test_Foo->new(
        zot => "three",
        bar => $bar,
    );

    my $foo_4 = KiokuDB_Test_Foo->new(
        zot => "two",
        bar => $bar,
        moof => [ KiokuDB_Test_Bar->new( blah => "yay" ), $bar ],
    );

    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    {
        my ( $buffer, @ids ) = $v->collapse( objects => [ $bar ], only_in_storage => 1 );

        my $entries = $buffer->_entries;

        is( scalar(keys %$entries), 1, "one entry" );
        is( scalar(@ids), 1, "one root set ID" );

        is( $entries->{$ids[0]}->class, "KiokuDB_Test_Bar", "class" );

        $buffer->update_entries( in_storage => 1 );
    }

    {
        my ( $buffer, @ids ) = $v->collapse( objects => [ $foo_1 ], only_in_storage => 1 );

        my $entries = $buffer->_entries;

        is( scalar(keys %$entries), 1, "one entry with only_in_storage" );
        is( scalar(@ids), 1, "one root set ID" );

        is( $entries->{$ids[0]}->class, "KiokuDB_Test_Foo", "class" );

        $buffer->update_entries( in_storage => 1 );
    }

    {
        my ( $buffer, @ids ) = $v->collapse( objects => [ $foo_2 ] );

        my $entries = $buffer->_entries;

        is( scalar(keys %$entries), 2, "two entries" );
        is( scalar(@ids), 1, "one root set ID" );

        is( $entries->{$ids[0]}->class, "KiokuDB_Test_Foo", "class" );

        $buffer->update_entries( in_storage => 1 );
    }

    {
        $lo->insert( foo_3 => $foo_3 );

        my ( $buffer, @ids ) = $v->collapse( objects => [ $foo_3 ], only_in_storage => 1 );

        my $entries = $buffer->_entries;

        is( $ids[0], "foo_3", "custom ID for object" );

        is( scalar(keys %$entries), 1, "one entry" );
        is( scalar(@ids), 1, "one root set ID" );

        is( $entries->{$ids[0]}->class, "KiokuDB_Test_Foo", "class" );

        $buffer->update_entries( in_storage => 1 );
    }

    lives_ok {
        my ( $buffer, @ids ) = $v->collapse( objects => [ $foo_4 ], only_in_storage => 1 );

        my $entries = $buffer->_entries;

        is( scalar(keys %$entries), 2, "two entries" );
        is( scalar(@ids), 1, "one root set ID" );

        is( $entries->{$ids[0]}->class, "KiokuDB_Test_Foo", "class" );

        ok( !exists($entries->{$lo->object_to_id($bar)}), "known object doesn't exist in entry set" );

        $buffer->update_entries( in_storage => 1 );

        is_deeply(
            $entries->{$ids[0]}->data->{moof},
            [
                KiokuDB::Reference->new( id => $lo->object_to_id($foo_4->moof->[0]) ),
                KiokuDB::Reference->new( id => $lo->object_to_id($bar) ),
            ],
            "references",
        );
    };
}

{
    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    {
        my ( $buffer, @ids ) = $v->collapse( objects => [ KiokuDB_Test_Baz->new( id => "foo" ) ] );

        my $entries = $buffer->_entries;

        is( scalar(keys %$entries), 1, "one entry" );
        is( scalar(@ids), 1, "one root set ID" );

        $buffer->update_entries( in_storage => 1 );
    }

    {
        throws_ok {
            $v->collapse( objects => [ KiokuDB_Test_Baz->new( id => "foo" ) ] );
        } qr/ID conflict/;
    }
}

{
    my $v = KiokuDB::Collapser->new(
        backend => KiokuDB::Backend::Hash->new,
        live_objects => my $lo = KiokuDB::LiveObjects->new,
        typemap_resolver => KiokuDB::TypeMap::Resolver->new(
            typemap => KiokuDB::TypeMap->new(
                entries => {
                    ARRAY => KiokuDB::TypeMap::Entry::Ref->new,
                    HASH  => KiokuDB::TypeMap::Entry::Ref->new,
                },
            ),
        ),
    );

    my $s = $lo->new_scope;

    {
        my ( $buffer, @ids ) = $v->collapse( objects => [ KiokuDB_Test_Quxx->new( id => "foo" ) ] );

        my $entries = $buffer->_entries;

        is( scalar(keys %$entries), 1, "one entry" );
        is( scalar(@ids), 1, "one root set ID" );

        $buffer->update_entries( in_storage => 1 );
    }

    {
        my ( $buffer, @ids );
        lives_ok {
            ( $buffer, @ids ) = $v->collapse( objects => [ KiokuDB_Test_Quxx->new( id => "foo" ) ] );
        } qr/ID conflict/;

        is_deeply( [ $buffer->entries ], [ ], "no entries produced for backend on duplicate CAS object" );
    }
}

done_testing;