dist/Storable/t/tied_items.t

   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
  13 sub 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
  25 use Storable qw(dclone);
  26 use Test::More tests => 8;
  27
  28 $h_fetches = 0;
  29
  30 sub H::TIEHASH { bless \(my $x), "H" }
  31 sub H::FETCH { $h_fetches++; $_[1] - 70 }
  32
  33 tie %h, "H";
  34
  35 $ref = \$h{77};
  36 $ref2 = dclone $ref;
  37
  38 is($h_fetches, 0);
  39 is($$ref2, $$ref);
  40 is($$ref2, 7);
  41 is($h_fetches, 2);
  42
  43 $a_fetches = 0;
  44
  45 sub A::TIEARRAY { bless \(my $x), "A" }
  46 sub A::FETCH { $a_fetches++; $_[1] - 70 }
  47
  48 tie @a, "A";
  49
  50 $ref = \$a[78];
  51 $ref2 = dclone $ref;
  52
  53 is($a_fetches, 0);
  54 is($$ref2, $$ref);
  55 is($$ref2, 8);
  56 # a bug in 5.12 and earlier caused an extra FETCH
  57 is($a_fetches, $] < 5.013 ? 3 : 2);