Commit | Line | Data |
---|---|---|
66f7f903 VT |
1 | #!./perl -w |
2 | # | |
3 | # This file tests that Storable correctly uses STORABLE_attach hooks | |
4 | ||
5 | sub 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 | ||
15 | use Test::More tests => 3; | |
16 | use 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 |