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 'lib/st-dump.pl';
  26 }
  27
  28 sub ok;
  29 $^W = 0;
  30
  31 print "1..8\n";
  32
  33 use Storable qw(dclone);
  34
  35 $h_fetches = 0;
  36
  37 sub H::TIEHASH { bless \(my $x), "H" }
  38 sub H::FETCH { $h_fetches++; $_[1] - 70 }
  39
  40 tie %h, "H";
  41
  42 $ref = \$h{77};
  43 $ref2 = dclone $ref;
  44
  45 ok 1, $h_fetches == 0;
  46 ok 2, $$ref2 eq $$ref;
  47 ok 3, $$ref2 == 7;
  48 ok 4, $h_fetches == 2;
  49
  50 $a_fetches = 0;
  51
  52 sub A::TIEARRAY { bless \(my $x), "A" }
  53 sub A::FETCH { $a_fetches++; $_[1] - 70 }
  54
  55 tie @a, "A";
  56
  57 $ref = \$a[78];
  58 $ref2 = dclone $ref;
  59
  60 ok 5, $a_fetches == 0;
  61 ok 6, $$ref2 eq $$ref;
  62 ok 7, $$ref2 == 8;
  63 # I don't understand why it's 3 and not 2
  64 ok 8, $a_fetches == 3;
  65