t/lib/st-tieditems.t

   1 #!./perl
   2
   3 # $Id: tied_items.t,v 0.7.1.2 2000/08/14 07:20:35 ram Exp $
   4 #
   5 #  Copyright (c) 1995-2000, Raphael Manfredi
   6 #
   7 #  You may redistribute only under the terms of the Artistic License,
   8 #  as specified in the README file that comes with the distribution.
   9 #
  10 # $Log: tied_items.t,v $
  11 # Revision 0.7.1.2  2000/08/14 07:20:35  ram
  12 # patch2: removed spurious dependency to Devel::Peek, used for testing only
  13 #
  14 # Revision 0.7.1.1  2000/08/13 20:10:31  ram
  15 # patch1: created
  16 #
  17
  18 #
  19 # Tests ref to items in tied hash/array structures.
  20 #
  21
  22 sub BEGIN {
  23     chdir('t') if -d 't';
  24     unshift @INC, '../lib';
  25     require Config; import Config;
  26     if ($Config{'extensions'} !~ /\bStorable\b/) {
  27         print "1..0 # Skip: Storable was not built\n";
  28         exit 0;
  29     }
  30     require 'lib/st-dump.pl';
  31 }
  32
  33 sub ok;
  34 $^W = 0;
  35
  36 print "1..8\n";
  37
  38 use Storable qw(dclone);
  39
  40 $h_fetches = 0;
  41
  42 sub H::TIEHASH { bless \(my $x), "H" }
  43 sub H::FETCH { $h_fetches++; $_[1] - 70 }
  44
  45 tie %h, "H";
  46
  47 $ref = \$h{77};
  48 $ref2 = dclone $ref;
  49
  50 ok 1, $h_fetches == 0;
  51 ok 2, $$ref2 eq $$ref;
  52 ok 3, $$ref2 == 7;
  53 ok 4, $h_fetches == 2;
  54
  55 $a_fetches = 0;
  56
  57 sub A::TIEARRAY { bless \(my $x), "A" }
  58 sub A::FETCH { $a_fetches++; $_[1] - 70 }
  59
  60 tie @a, "A";
  61
  62 $ref = \$a[78];
  63 $ref2 = dclone $ref;
  64
  65 ok 5, $a_fetches == 0;
  66 ok 6, $$ref2 eq $$ref;
  67 ok 7, $$ref2 == 8;
  68 # I don't understand why it's 3 and not 2
  69 ok 8, $a_fetches == 3;
  70