#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Scalar::Util qw(refaddr blessed);
use KiokuDB::TypeMap::Entry::Passthrough;
use KiokuDB::TypeMap::Entry::Naive;
use KiokuDB::TypeMap::Resolver;
use KiokuDB::Collapser;
use KiokuDB::Linker;
use KiokuDB::LiveObjects;
use KiokuDB::Backend::Hash;
{
package KiokuDB_Test_Foo;
use Moose;
has foo => ( is => "rw" );
package KiokuDB_Test_Bar;
use Moose;
has foo => ( is => "rw" );
package KiokuDB_Test_Gorch;
use Moose;
has foo => ( is => "rw" );
}
my $foo = KiokuDB_Test_Foo->new( foo => "HALLO" );
my $bar = KiokuDB_Test_Gorch->new( foo => KiokuDB_Test_Bar->new( foo => "LULZ" ) );
my $p = KiokuDB::TypeMap::Entry::Passthrough->new();
my $pi = KiokuDB::TypeMap::Entry::Passthrough->new( intrinsic => 1 );
my $n = KiokuDB::TypeMap::Entry::Naive->new;
my $tr = KiokuDB::TypeMap::Resolver->new(
typemap => KiokuDB::TypeMap->new(
entries => {
KiokuDB_Test_Foo => $p,
KiokuDB_Test_Bar => $pi,
},
),
);
my $v = KiokuDB::Collapser->new(
backend => KiokuDB::Backend::Hash->new,
live_objects => KiokuDB::LiveObjects->new,
typemap_resolver => $tr,
);
my $sc = $v->live_objects->new_scope;
my $l = KiokuDB::Linker->new(
backend => KiokuDB::Backend::Hash->new,
live_objects => KiokuDB::LiveObjects->new,
typemap_resolver => $tr,
);
{
$l->live_objects->clear;
my $sl = $l->live_objects->new_scope;
my ( $buffer ) = $v->collapse( objects => [ $foo ], );
my $entries = $buffer->_entries;
is( scalar(keys %$entries), 1, "one entry" );
my $entry = ( values %$entries )[0];
isa_ok( $entry->data, "KiokuDB_Test_Foo", "entry data" );
is( refaddr($entry->data), refaddr($foo), "refaddr equals" );
my $expanded = $l->expand_object($entry);
isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" );
is( refaddr($expanded), refaddr($foo), "refaddr equals" );
}
{
$l->live_objects->clear;
my $sl = $l->live_objects->new_scope;
my ( $buffer ) = $v->collapse( objects => [ $bar ], );
my $entries = $buffer->_entries;
is( scalar(keys %$entries), 1, "one entry" );
my $entry = ( values %$entries )[0];
is( (blessed($entry->data)||''), '', "entry data not blessed" );
isa_ok( $entry->data->{foo}, "KiokuDB_Test_Bar", "intrinsic entry" );
is( refaddr($entry->data->{foo}), refaddr($bar->foo), "refaddr equals" );
my $expanded = $l->expand_object($entry);
isa_ok( $expanded, "KiokuDB_Test_Gorch", "expanded object" );
is( refaddr($expanded->foo), refaddr($bar->foo), "expanded intrinsic refaddr" );
is_deeply( $expanded->foo, $bar->foo, "eq deeply" );
}
# inflate data edge cases for backwards compat
{
$l->live_objects->clear;
my $sl = $l->live_objects->new_scope;
my ( $buffer ) = $v->collapse( objects => [ $bar ], );
my $entries = $buffer->_entries;
is( scalar(keys %$entries), 1, "one entry" );
my $entry = ( values %$entries )[0];
$entry->data->{foo} = KiokuDB::Entry->new( data => $entry->data->{foo} );
my $expanded = $l->expand_object($entry);
isa_ok( $expanded, "KiokuDB_Test_Gorch", "expanded object" );
is( refaddr($expanded->foo), refaddr($bar->foo), "expanded intrinsic refaddr" );
is_deeply( $expanded->foo, $bar->foo, "eq deeply" );
}
{
$l->live_objects->clear;
my $sl = $l->live_objects->new_scope;
my ( $buffer ) = $v->collapse( objects => [ $bar ], );
my $entries = $buffer->_entries;
is( scalar(keys %$entries), 1, "one entry" );
my $entry = ( values %$entries )[0];
$entry->data->{foo} = KiokuDB::Entry->new( data => $entry->data->{foo}, class => ref($entry->data->{foo}) );
my $expanded = $l->expand_object($entry);
isa_ok( $expanded, "KiokuDB_Test_Gorch", "expanded object" );
is( refaddr($expanded->foo), refaddr($bar->foo), "expanded intrinsic refaddr" );
is_deeply( $expanded->foo, $bar->foo, "eq deeply" );
}
done_testing;