|
Packit |
14c646 |
#!./perl
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Copyright (c) 1995-2000, Raphael Manfredi
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# You may redistribute only under the same terms as Perl 5, as specified
|
|
Packit |
14c646 |
# in the README file that comes with the distribution.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Tests ref to items in tied hash/array structures.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub BEGIN {
|
|
Packit |
14c646 |
unshift @INC, 't';
|
|
Packit |
14c646 |
unshift @INC, 't/compat' if $] < 5.006002;
|
|
Packit |
14c646 |
require Config; import Config;
|
|
Packit |
14c646 |
if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
|
|
Packit |
14c646 |
print "1..0 # Skip: Storable was not built\n";
|
|
Packit |
14c646 |
exit 0;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$^W = 0;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
use Storable qw(dclone);
|
|
Packit |
14c646 |
use Test::More tests => 8;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$Storable::flags = Storable::FLAGS_COMPAT;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$h_fetches = 0;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub H::TIEHASH { bless \(my $x), "H" }
|
|
Packit |
14c646 |
sub H::FETCH { $h_fetches++; $_[1] - 70 }
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
tie %h, "H";
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$ref = \$h{77};
|
|
Packit |
14c646 |
$ref2 = dclone $ref;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
is($h_fetches, 0);
|
|
Packit |
14c646 |
is($$ref2, $$ref);
|
|
Packit |
14c646 |
is($$ref2, 7);
|
|
Packit |
14c646 |
is($h_fetches, 2);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$a_fetches = 0;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub A::TIEARRAY { bless \(my $x), "A" }
|
|
Packit |
14c646 |
sub A::FETCH { $a_fetches++; $_[1] - 70 }
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
tie @a, "A";
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$ref = \$a[78];
|
|
Packit |
14c646 |
$ref2 = dclone $ref;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
is($a_fetches, 0);
|
|
Packit |
14c646 |
is($$ref2, $$ref);
|
|
Packit |
14c646 |
is($$ref2, 8);
|
|
Packit |
14c646 |
# a bug in 5.12 and earlier caused an extra FETCH
|
|
Packit |
14c646 |
is($a_fetches, $] < 5.013 ? 3 : 2);
|