use strict; local $^W = 1; use Test::More; use Scalar::Util qw( refaddr ); $|++; # keep stdout and stderr in order on Win32 (maybe) my %constructors_for = ( 't::Object::Singleton::MissingConstructor' => 'get_it', ); # Need Storable 2.14 ( STORABLE_attach support ) eval { require Storable and Storable->VERSION( 2.14 ) }; if ( $@ ) { plan skip_all => "Storable >= 2.14 needed for singleton support", } else { plan tests => 6 * scalar keys %constructors_for; } #--------------------------------------------------------------------------# my $name = "Neo"; #--------------------------------------------------------------------------# for my $class ( keys %constructors_for ) { require_ok( $class ); my $o; # create the object my $new = $class->can( $constructors_for{$class} ); ok( $o = $new->($class), "... Creating $class object" ); # set a name $o->name( $name ); is( $o->name(), $name, "... Setting 'name' to '$name'" ); # freeze object my ( $frozen, $thawed ); ok( $frozen = Storable::freeze( $o ), "... Freezing $class object" ); # thaw object -- should die because no "new()" and no # STORABLE_attach_hook my $error; eval { local $SIG{__WARN__} = sub { $error = shift }; $thawed = Storable::thaw( $frozen ); }; like( $@, "/STORABLE_attach did not return a $class\/", "... Thawing without constructor throws error" ); like( $error, "/Error attaching to $class\/", "... Warning message seen" ); }