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    if ($ENV{PERL_CORE}){
15	chdir('t') if -d 't';
16	@INC = ('.', '../lib', '../ext/Storable/t');
17    } else {
18	unshift @INC, 't';
19    }
20    require Config; import Config;
21    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
22        print "1..0 # Skip: Storable was not built\n";
23        exit 0;
24    }
25    require 'st-dump.pl';
26}
27
28sub ok;
29$^W = 0;
30
31print "1..8\n";
32
33use Storable qw(dclone);
34
35$h_fetches = 0;
36
37sub H::TIEHASH { bless \(my $x), "H" }
38sub H::FETCH { $h_fetches++; $_[1] - 70 }
39
40tie %h, "H";
41
42$ref = \$h{77};
43$ref2 = dclone $ref;
44
45ok 1, $h_fetches == 0;
46ok 2, $$ref2 eq $$ref;
47ok 3, $$ref2 == 7;
48ok 4, $h_fetches == 2;
49
50$a_fetches = 0;
51
52sub A::TIEARRAY { bless \(my $x), "A" }
53sub A::FETCH { $a_fetches++; $_[1] - 70 }
54
55tie @a, "A";
56
57$ref = \$a[78];
58$ref2 = dclone $ref;
59
60ok 5, $a_fetches == 0;
61ok 6, $$ref2 eq $$ref;
62ok 7, $$ref2 == 8;
63# I don't understand why it's 3 and not 2
64ok 8, $a_fetches == 3;
65