| Subject: | Storable incompatible with singleton classes |
Storable spuriously creates illegal blessed hash references in STORABLE_thaw.
This bug is related to bug #4901 and bug #6641, and will be fixed if point 2) from bug #6641 is implemented, but I'm adding it here as a seperate case, primarily because I've encapsulared the issue as a test case you can add to the Storable dist.
------------------------------------------------
singleton.t
------------------------------------------------
#!/usr/bin/perl -w
# Tests the freezing/thawing structures containing Singleton objects,
# which should see both structs pointing to the same object.
# In order to make this test work, ANY method needs to exist that can
# be used in STORABLE_freeze and STORABLE_thaw in order to make the tests
# pass.
use Storable ();
use Test::More tests => 7;
# Get the singleton
my $object = My::Singleton->new;
isa_ok( $object, 'My::Singleton' );
# Confirm (for the record) that the class is actually a Singleton
my $object2 = My::Singleton->new;
isa_ok( $object2, 'My::Singleton' );
is( "$object", "$object2", 'Class is a singleton' );
############
# Main Tests
my $struct = [ 1, $object, 3 ];
# Freeze the struct
my $frozen = Storable::freeze( $struct );
ok( (defined($frozen) and ! ref($frozen) and length($frozen)), 'freeze returns a string' );
# Thaw the struct
my $thawed = Storable::thaw( $frozen );
# Now it should look exactly like the original
is_deeply( $struct, $thawed, 'Struct superficially looks like the original' );
# ... EXCEPT that the Singleton should be the same instance of the object
is( "$struct->[1]", "$thawed->[1]", 'Singleton thaws correctly' );
# We can also test this empirically
$struct->[1]->{value} = 'Goodbye cruel world!';
is_deeply( $struct, $thawed, 'Empiric testing corfirms correct behaviour' );
# End Tests
###########
package My::Singleton;
my $SINGLETON = undef;
sub new {
$SINGLETON or
$SINGLETON = bless { value => 'Hello World!' }, $_[0];
}
sub STORABLE_freeze {
my $self = shift;
# We don't actually need to return anything, but provide a null string
# to avoid the null-list-return behaviour.
return ('');
}
sub STORABLE_thaw {
my ($obj, $string) = @_;
# Get the Singleton object
my $self = My::Singleton->new;
### IS THERE ANY POSSIBLE CODE FOR STORABLE_thaw THAT CAN
### BE USED TO PASS THE TESTS???
### LET'S TRY TO DOCUMENTED WAY OF CREATING THE OBJECT
%$obj = %$self;
return;
}
# This one would work under the proposed changes to Storable
sub STORABLE_thaw_new {
My::Singleton->new;
}