1#!./perl -w 2# 3# This file tests that Storable correctly uses STORABLE_attach hooks 4 5sub BEGIN { 6 unshift @INC, 't'; 7 unshift @INC, 't/compat' if $] < 5.006002; 8 require Config; import Config; 9 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { 10 print "1..0 # Skip: Storable was not built\n"; 11 exit 0; 12 } 13} 14 15use Test::More tests => 3; 16use Storable (); 17 18{ 19 my $destruct_cnt = 0; 20 my $obj = bless {data => 'ok'}, 'My::WithDestructor'; 21 my $target = Storable::thaw( Storable::freeze( $obj ) ); 22 is( $target->{data}, 'ok', 'We got correct object after freeze/thaw' ); 23 is( $destruct_cnt, 0, 'No tmp objects created by Storable' ); 24 undef $obj; 25 undef $target; 26 is( $destruct_cnt, 2, 'Only right objects destroyed at the end' ); 27 28 package My::WithDestructor; 29 30 sub STORABLE_freeze { 31 my ($self, $clone) = @_; 32 return $self->{data}; 33 } 34 35 sub STORABLE_attach { 36 my ($class, $clone, $string) = @_; 37 return bless {data => $string}, 'My::WithDestructor'; 38 } 39 40 sub DESTROY { $destruct_cnt++; } 41} 42 43