#!./perl

use Test::More tests => 16;

use Storable ();

use warnings;
use strict;

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