1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
#!perl -w
use strict;
use Test qw(plan ok);
use Data::Dump qw(dump);
plan tests => 4;
{
package MyTie;
sub TIE {
my $class = shift;
bless {}, $class;
}
use vars qw(*TIEHASH *TIEARRAY *TIESCALAR);
*TIEHASH = \&TIE;
*TIEARRAY = \&TIE;
*TIESCALAR = \&TIE;
sub FIRSTKEY {
return "a";
}
sub NEXTKEY {
my($self, $lastkey) = @_;
return if $lastkey eq "d";
return ++$lastkey;
}
sub FETCHSIZE {
return 4;
}
sub FETCH {
my($self, $key) = @_;
return "v$key" if defined $key;
return "v";
}
}
my(%hash, @array, $scalar);
tie %hash, "MyTie";
tie @array, "MyTie";
tie $scalar, "MyTie";
ok(nl(dump(\%hash)), <<EOT);
{
# tied MyTie
a => "va",
b => "vb",
c => "vc",
d => "vd",
}
EOT
ok(nl(dump(\@array)), <<EOT);
[
# tied MyTie
"v0" .. "v3",
]
EOT
ok(nl(dump($scalar)), <<EOT);
"v"
EOT
ok(nl(dump($scalar, $scalar, $scalar)), <<EOT);
("v", "v", "v")
EOT
sub nl { shift(@_) . "\n" }
|
