/Class-InsideOut-1.10/t/12_storable_hooks.t

use strict;
use Test::More;
use Class::InsideOut ();
use Scalar::Util qw( refaddr reftype );

$|++; # keep stdout and stderr in order on Win32

my $class    = "t::Object::Animal::Jackalope";
my $gp_class = "t::Object::Animal";

# Need Storable 2.04 ( relatively safe STORABLE_freeze support )
eval { require Storable and Storable->VERSION( 2.04 ) };
if ( $@ ) {
    plan skip_all => "Storable >= 2.04 not installed",
}
else
{
    plan tests => 10;
}

#--------------------------------------------------------------------------#
# tests
#--------------------------------------------------------------------------#

require_ok( $class );
my $o;
# create the object
ok( $o = $class->new(),  
    "... Creating $class object"
);

# note the underlying type
my $type;
ok( $type = reftype($o),
    "... Object is reftype $type"
);

# freeze object
my ( $frozen, $thawed );
ok( $frozen = Storable::freeze( $o ),
    "... Freezing object"
);

# check that hooks worked
{
    no strict 'refs';
    is( ${ $class . "::freezings"}, 1,
        "... $class freeze hook updated freeze count"
    );
    is( ${ $gp_class . "::freezings"}, 1,
        "... $gp_class freeze hook updated freeze count (diamond pattern)"
    );
}

# thaw object
ok( $thawed = Storable::thaw( $frozen ),
    "... Thawing object"
);
isnt( refaddr $o, refaddr $thawed,
    "... Thawed object is a copy"
);

# check that hooks worked
{
    no strict 'refs';
    is( ${ $class . "::thawings"}, 1,
        "... $class thaw hook updated thaw count"
    );
    is( ${ $gp_class . "::thawings"}, 1,
        "... $gp_class thaw hook updated thaw count (diamond pattern)"
    );
}