/
hash.t
104 lines (94 loc) · 3.3 KB
/
hash.t
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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
use v6.c;
use Test;
use P5tie;
my int $tiehashed;
my int $fetched;
my int $stored;
my int $existed;
my int $deleted;
my int $cleared;
my int $firstkeyed;
my int $nextkeyed;
my int $scalared;
my int $untied;
my int $tested;
class Foo {
has Int %.tied;
has @.keys;
has int $.index is rw;
our sub TIEHASH($self) is raw { ++$tiehashed; $self.new }
our sub FETCH($self,$k) is raw { ++$fetched; $self.tied.AT-KEY($k) }
our sub STORE($self,$k,\val) is raw {++$stored; $self.tied.ASSIGN-KEY($k,val)}
our sub EXISTS($self,$k) { ++$existed; $self.tied.EXISTS-KEY($k) }
our sub DELETE($self,$k) { ++$deleted; $self.tied.DELETE-KEY($k) }
our sub CLEAR($self) { ++$cleared; $self.tied = () }
our sub FIRSTKEY($self) is raw {
++$firstkeyed;
($self.keys = $self.tied.keys)[$self.index = 0]
}
our sub NEXTKEY($self,$k) is raw {++$nextkeyed; $self.keys[++$self.index]}
our sub SCALAR($self) is raw { ++$scalared; ?$self.tied }
our sub UNTIE($self) is raw { ++$untied; $self.tied }
our sub DESTROY($self) { }
}
class Bar {
has Int %.tied;
has @!keys;
has int $!index;
method TIEHASH() is raw { ++$tiehashed; self.new }
method FETCH($k) is raw { ++$fetched; %!tied.AT-KEY($k) }
method STORE($k,\val) is raw { ++$stored; %!tied.ASSIGN-KEY($k,val) }
method EXISTS($k) { ++$existed; %!tied.EXISTS-KEY($k) }
method DELETE($k) { ++$deleted; %!tied.DELETE-KEY($k) }
method CLEAR() { ++$cleared; %!tied = () }
method FIRSTKEY() is raw {
++$firstkeyed;
(@!keys = %!tied.keys)[$!index = 0]
}
method NEXTKEY($k) is raw { ++$nextkeyed; @!keys[++$!index] }
method SCALAR() is raw { ++$scalared; ?%!tied }
method UNTIE() is raw { ++$untied; %!tied }
method DESTROY() { }
}
class Baz is Bar { }
my @interfaces = Foo, Bar, Baz;
plan 7 * @interfaces;
sub test-access(
int :$tiehash,
int :$fetch = 1,
int :$store,
int :$exists,
int :$delete,
int :$clear,
int :$firstkey,
int :$nextkey,
int :$scalar,
int :$untie,
) {
subtest {
plan 4;
is $tiehashed, $tiehash,
"did we {"NOT " unless $tiehash}see a TIEHASH?";
ok $fetched >= $fetch,
"did we see at least $fetch FETCH(es)?";
is $stored, $store,
"did we {"NOT " unless $store}see a STORE?";
is $untied, $untie,
"did we {"NOT " unless $untie}see an UNTIE?";
$tiehashed = $fetched = $stored = $existed = $deleted =
$cleared = $firstkeyed = $nextkeyed = $scalared = $untied = 0;
}, "test accesses #{++$tested} of tied array";
}
for @interfaces -> $class {
my $object = tie my %a, $class;
isa-ok $object, $class, "is the object a {$class.^name}?";
is %a<a>, Int, 'did we get Int';
test-access(:1tiehash);
%a<a> = 666;
is %a<a>, 666, 'did we get 666';
test-access(:1store);
++%a<a>;;
is %a<a>, 667, 'did we get 667';
test-access(:1store);
}
# vim: ft=perl6 expandtab sw=4