#!./perl

use strict;
use warnings;

use Test::More tests => 16;

use Storable ();

package TEST;

sub make {
    my $pkg = shift;
    return bless { a => 1, b => 2 }, $pkg;
}

package TIED_HASH;

sub TIEHASH {
    my $pkg = shift;
    return bless { a => 1, b => 2 }, $pkg;
}

sub FETCH {
    my ($self, $key) = @_;
    return $self->{$key};
}

sub STORE {
    my ($self, $key, $value) = @_;
    $self->{$key} = $value;
}

sub FIRSTKEY {
    my $self = shift;
    keys %$self;
    return each %$self;
}

sub NEXTKEY {
    my $self = shift;
    return each %{$self};
}

sub EXISTS {
    my ($self, $key) = @_;
    return exists $self->{$key};
}

package main;

{
    my $obj = TEST->make;

    is_deeply($obj, { a => 1, b => 2 }, "object contains correct data");

    my $frozen = Storable::freeze($obj);
    my ($t1, $t2) = Storable::thaw($frozen);

    {
        no warnings 'once';
        local $Storable::flags = Storable::FLAGS_COMPAT();
        $t2 = Storable::thaw($frozen);
    }

    is_deeply($t1, $t2, "objects contain matching data");
    is(ref $t1, 'TEST', "default object is blessed");
    is(ref $t2, 'TEST', "compat object is blessed into correct class");

    my $t3 = Storable::thaw($frozen, Storable::FLAGS_COMPAT());
    is_deeply($t2, $t3, "objects contain matching data (explicit test)");
    is(ref $t3, 'TEST', "compat object is blessed into correct class (explicit test)");

    my $t4 = Storable::thaw($frozen, Storable::BLESS_OK());
    is_deeply($t2, $t3, "objects contain matching data (explicit test for bless)");
    is(ref $t3, 'TEST', "compat object is blessed into correct class (explicit test for bless)");

    {
        no warnings 'once';
        local $Storable::flags = Storable::FLAGS_COMPAT();
        my $t5 = Storable::thaw($frozen, 0);
        my $t6 = Storable::thaw($frozen, Storable::TIE_OK());

        is_deeply($t1, $t5, "objects contain matching data");
        is_deeply($t1, $t6, "objects contain matching data for TIE_OK");
        is(ref $t5, 'HASH', "default object is unblessed");
        is(ref $t6, 'HASH', "TIE_OK object is unblessed");
    }
}

{
    tie my %hash, 'TIED_HASH';
    ok(tied %hash, "hash is tied");
    my $obj = { bow => \%hash };

    my $frozen = Storable::freeze($obj);
    my $t1 = Storable::thaw($frozen, Storable::FLAGS_COMPAT());
    my $t2 = eval { Storable::thaw($frozen); };

    ok(!$@, "trying to thaw a tied value succeeds");
    ok(tied %{$t1->{bow}}, "compat object is tied");
    is(ref tied %{$t1->{bow}}, 'TIED_HASH', "compat object is tied into correct class");
}
