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

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

# 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",
}

sub check_version {
    my ($class, $version) = @_;
    eval { require $class and $class->VERSION($version) };
    return $@ eq q{} ? 0 : 1;
}
    
my @serializers = (
    {
        class   => "Storable",
        version => 3.04,
        freeze  => sub { Storable::freeze( shift ) },
        thaw    => sub { Storable::thaw( shift ) },
    },
);

my @classes = qw(
    t::Object::Scalar
    t::Object::Array
    t::Object::Hash
    t::Object::Animal::Jackalope
);
    
my %custom_prop_for_class = (
    "t::Object::Scalar"  => {
        age => "32" 
    },
    "t::Object::Array"   => {
        height => "72 inches"
    },
    "t::Object::Hash"    => { 
        weight => "190 lbs" 
    },
    "t::Object::Animal::Jackalope" => {
        color => "white",
        speed => "60 mph",
        points => 13,
        kills => 23,
    },
);

my $prop_count;
$prop_count++ for map { keys %$_ } values %custom_prop_for_class;

my $tests_per_serializer = ( 1 + (11 * @classes) + (2 * $prop_count) );

plan tests => @serializers * $tests_per_serializer;

#--------------------------------------------------------------------------#
# Setup test data
#--------------------------------------------------------------------------#

my %content_for_type = (
    SCALAR  => \do { my $s = 3.14159 },
    ARRAY   => [1, 1, 2, 3, 5, 8 ],
    HASH    => { 1 => 1, 2 => 4, 3 => 9, 4 => 16 },
);

my %names_for_class = (
    "t::Object::Scalar"             => "Larry",
    "t::Object::Array"              => "Moe",
    "t::Object::Hash"               => "Curly",
    "t::Object::Animal::Jackalope"  => "Fred",
);

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

for my $s ( @serializers ) {

    SKIP:
    {
    
        skip "$s->{class} $s->{version} required", $tests_per_serializer
            unless check_version( $s->{class}, $s->{version} );
        
        require_ok( $s->{class} );

        for my $class ( @classes ) {
            no strict 'refs';
            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"
            );
            
            # set a name
            my $name = $names_for_class{ $class };
            $o->name( $name );
            is( $o->name(), $name,
                "... Setting 'name' to '$name'"
            );
            
            # set class-specific properties
            for my $prop ( keys %{ $custom_prop_for_class{ $class } } ) {;
                my $val = $custom_prop_for_class{ $class }{ $prop };
                $o->$prop( $val );
                is( $o->$prop(), $val,
                    "... Setting custom '$prop' property to $val"
                );
            }
            
            # store class-specific data in the reference
            my $data = $content_for_type{ $type };
            for ( reftype $o ) {
                /SCALAR/ && do { $$o = $$data; last };
                /ARRAY/  && do { @$o = @$data; last };
                /HASH/   && do { %$o = %$data; last };
            }
            pass( "... Loading base $type with data" );

            # freeze object
            my ( $frozen, $thawed );
            ok( $frozen = $s->{freeze}->( $o ),
                "... Freezing object"
            );

            # thaw object
            ok( $thawed = $s->{thaw}->( $frozen ),
                "... Thawing object"
            );
            isnt( refaddr $o, refaddr $thawed,
                "... Thawed object is a copy"
            );
            # check name
            is( $thawed->name(), $name,
                "... Property 'name' for thawed object is correct?"
            ) ;

            # check class-specific properties
            for my $prop ( keys %{ $custom_prop_for_class{ $class } } ) {;
                my $val = $custom_prop_for_class{ $class }{ $prop };
                is( $thawed->$prop(), $val,
                    "... Property '$prop' for thawed objects is correct?"
                );
            }
            
            # check thawed contents
            is_deeply( $thawed, $data,
                "... Thawed object contents are correct"
            );
            
            my @leaks = Class::InsideOut::_leaking_memory;
            ok( ! scalar @leaks,
                "... $class not leaking memory"
            ) or diag "Leaks in: @leaks";
        };
    }
}