File: typemap_entry_naive.t

package info (click to toggle)
libkiokudb-perl 0.57-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 1,396 kB
  • sloc: perl: 13,314; makefile: 12
file content (118 lines) | stat: -rw-r--r-- 3,143 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

use Scalar::Util qw(refaddr reftype blessed);

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" );

    has bar => ( is => "rw", isa => "KiokuDB_Test_Bar" );

    package KiokuDB_Test_Bar;
    use Moose;

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

my $obj = KiokuDB_Test_Foo->new( foo => "HALLO" );

my $deep = KiokuDB_Test_Foo->new( foo => "la", bar => KiokuDB_Test_Bar->new( blah => "hai" ) );

my $n = KiokuDB::TypeMap::Entry::Naive->new();
my $i = KiokuDB::TypeMap::Entry::Naive->new( intrinsic => 1 );

my $tr = KiokuDB::TypeMap::Resolver->new(
    typemap => KiokuDB::TypeMap->new(
        entries => {
            KiokuDB_Test_Foo => $n,
            KiokuDB_Test_Bar => $i,
        },
    ),
);

my $v = KiokuDB::Collapser->new(
    backend => KiokuDB::Backend::Hash->new,
    live_objects => KiokuDB::LiveObjects->new,
    typemap_resolver => $tr,
);

my $l = KiokuDB::Linker->new(
    backend => KiokuDB::Backend::Hash->new,
    live_objects => KiokuDB::LiveObjects->new,
    typemap_resolver => $tr,
);

{
    my $s = $v->live_objects->new_scope;

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

    my $entries = $buffer->_entries;

    is( scalar(keys %$entries), 1, "one entry" );

    my $entry = ( values %$entries )[0];

    isnt( refaddr($entry->data), refaddr($obj), "refaddr doesn't equal" );
    ok( !blessed($entry->data), "entry data is not blessed" );
    is( reftype($entry->data), reftype($obj), "reftype" );
    is_deeply( $entry->data, {%$obj}, "is_deeply" );

    my $sl = $l->live_objects->new_scope;

    my $expanded = $l->expand_object($entry);

    isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" );
    isnt( refaddr($expanded), refaddr($obj), "refaddr doesn't equal" );
    isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" );
    is_deeply( $expanded, $obj, "is_deeply" );
}

{
    my $s = $v->live_objects->new_scope;

    my $bar = $deep->bar;

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

    my $entries = $buffer->_entries;

    is( scalar(keys %$entries), 1, "one entry" );

    my $entry = ( values %$entries )[0];

    isnt( refaddr($entry->data), refaddr($deep), "refaddr doesn't equal" );
    ok( !blessed($entry->data), "entry data is not blessed" );
    is( reftype($entry->data), reftype($deep), "reftype" );
    is_deeply(
        $entry->data,
        {%$deep, bar => KiokuDB::Entry->new( class => "KiokuDB_Test_Bar", data => {%$bar}, object => $bar ) },
        "is_deeply"
    );

    my $sl = $l->live_objects->new_scope;

    my $expanded = $l->expand_object($entry);

    isa_ok( $expanded, "KiokuDB_Test_Foo", "expanded object" );
    isnt( refaddr($expanded), refaddr($deep), "refaddr doesn't equal" );
    isnt( refaddr($expanded), refaddr($entry->data), "refaddr doesn't entry data refaddr" );
    is_deeply( $expanded, $deep, "is_deeply" );
}


done_testing;