Blame t/tied_items.t

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);