1#!./perl 2# 3# Copyright (c) 1995-2000, Raphael Manfredi 4# 5# You may redistribute only under the same terms as Perl 5, as specified 6# in the README file that comes with the distribution. 7# 8 9# 10# Tests ref to items in tied hash/array structures. 11# 12 13sub BEGIN { 14 unshift @INC, 't'; 15 unshift @INC, 't/compat' if $] < 5.006002; 16 require Config; import Config; 17 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { 18 print "1..0 # Skip: Storable was not built\n"; 19 exit 0; 20 } 21} 22 23$^W = 0; 24 25use Storable qw(dclone); 26use Test::More tests => 8; 27 28$Storable::flags = Storable::FLAGS_COMPAT; 29 30$h_fetches = 0; 31 32sub H::TIEHASH { bless \(my $x), "H" } 33sub H::FETCH { $h_fetches++; $_[1] - 70 } 34 35tie %h, "H"; 36 37$ref = \$h{77}; 38$ref2 = dclone $ref; 39 40is($h_fetches, 0); 41is($$ref2, $$ref); 42is($$ref2, 7); 43is($h_fetches, 2); 44 45$a_fetches = 0; 46 47sub A::TIEARRAY { bless \(my $x), "A" } 48sub A::FETCH { $a_fetches++; $_[1] - 70 } 49 50tie @a, "A"; 51 52$ref = \$a[78]; 53$ref2 = dclone $ref; 54 55is($a_fetches, 0); 56is($$ref2, $$ref); 57is($$ref2, 8); 58# a bug in 5.12 and earlier caused an extra FETCH 59is($a_fetches, $] < 5.013 ? 3 : 2); 60