-
Notifications
You must be signed in to change notification settings - Fork 135
/
hash.t
158 lines (130 loc) · 7.13 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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
use Test;
=begin pod
This file was originally derived from the Perl CPAN module Perl6::Rules,
version 0.3 (12 Apr 2004), file t/hash_cap.t.
=end pod
plan 116;
# L<S05/Hash aliasing/An alias can also be specified using a hash>
ok(" a b\tc" ~~ m/%<chars>=( \s+ \S+ )/, 'Named unrepeated hash capture');
ok($/<chars>{' a'}:exists, 'One key captured');
ok(!defined($/<chars>{' a'}), 'One value undefined');
ok($/<chars>.keys == 1, 'No extra unrepeated captures');
ok(" a b\tc" ~~ m/%<chars>=( \s+ \S+ )+/, 'Named simple hash capture');
ok($/<chars>{' a'}:exists, 'First simple key captured');
ok(!defined($/<chars>{' a'}), 'First simple value undefined');
ok($/<chars>{' b'}:exists, 'Second simple key captured');
ok(!defined($/<chars>{' b'}), 'Second simple value undefined');
ok($/<chars>{"\tc"}:exists, 'Third simple key captured');
ok(!defined($/<chars>{"\tc"}), 'Third simple value undefined');
ok($/<chars>.keys == 3, 'No extra simple captures');
ok(" a b\tc" ~~ m/%<first>=( \s+ \S+ )+ %<last>=( \s+ \S+)+/, 'Sequential simple hash capture');
ok($/<first>{' a'}:exists, 'First sequential key captured');
ok(!defined($/<first>{' a'}), 'First sequential value undefined');
ok($/<first>{' b'}:exists, 'Second sequential key captured');
ok(!defined($/<first>{' b'}), 'Second sequential value undefined');
ok($/<last>{"\tc"}:exists, 'Third sequential key captured');
ok(!defined($/<last>{"\tc"}), 'Third sequential value undefined');
ok($/<first>.keys == 2, 'No extra first sequential captures');
ok($/<last>.keys == 1, 'No extra last sequential captures');
ok("abcxyd" ~~ m/a %<foo>=(.(.))+ d/, 'Repeated nested hash capture');
ok($/<foo>{'c'}:exists, 'Nested key 1 captured');
ok(!defined($/<foo><c>), 'No nested value 1 captured');
ok($/<foo>{'y'}:exists, 'Nested key 2 captured');
ok(!defined($/<foo><y>), 'No nested value 2 captured');
ok($/<foo>.keys == 2, 'No extra nested captures');
ok("abcd" ~~ m/a %<foo>=(.(.)) d/, 'Unrepeated nested hash capture');
ok($/<foo>{'c'}:exists, 'Unrepeated key captured');
ok(!defined($/<foo><c>), 'Unrepeated value not captured');
ok($/<foo>.keys == 1, 'No extra unrepeated nested captures');
ok("abcd" ~~ m/a %<foo>=((.)(.)) d/, 'Unrepeated nested hash multicapture');
ok($/<foo>{'b'}:exists, 'Unrepeated key multicaptured');
ok(~$/<foo><b>, 'c', 'Unrepeated value not multicaptured');
ok($/<foo>.keys == 1, 'No extra unrepeated nested multicaptures');
ok("abcxyd" ~~ m/a %<foo>=((.)(.))+ d/, 'Repeated nested hash multicapture');
ok($/<foo>{'b'}:exists, 'Nested key 1 multicaptured');
ok($/<foo><b>, 'c', 'Nested value 1 multicaptured');
ok($/<foo>{'x'}:exists, 'Nested key 2 multicaptured');
ok($/<foo><x>, 'y', 'Nested value 2 multicaptured');
ok($/<foo>.keys == 2, 'No extra nested multicaptures');
our %foo;
ok("abcxyd" ~~ m/a %foo=(.(.))+ d/, 'Package hash capture');
ok(%foo{'c'}:exists, 'Package hash key 1 captured');
ok(!defined(%foo<c>), 'Package hash value 1 not captured');
ok(%foo{'y'}:exists, 'Package hash key 2 captured');
ok(!defined(%foo<y>), 'Package hash value 2 not captured');
ok(%foo.keys == 2, 'No extra package hash captures');
regex two {..}
ok("abcd" ~~ m/a %<foo>=[<two>] d/, 'Compound hash capture');
is($/<two>, "bc", 'Implicit subrule variable captured');
ok($/<foo>.keys == 0, 'Explicit hash variable not captured');
ok(" a b\tc" ~~ m/%<chars>=( %<spaces>=[\s+] (\S+))+/, 'Nested multihash capture');
ok($/<chars>{'a'}:exists, 'Outer hash capture key 1');
ok(!defined($/<chars><a>), 'Outer hash no capture value 1');
ok($/<chars>{'b'}:exists, 'Outer hash capture key 2');
ok(!defined($/<chars><b>), 'Outer hash no capture value 2');
ok($/<chars>{'c'}:exists, 'Outer hash capture key 3');
ok(!defined($/<chars><c>), 'Outer hash no capture value 3');
ok($/<chars>.keys == 3, 'Outer hash no extra captures');
ok($/<spaces>{' '}:exists, 'Inner hash capture key 1');
ok(!defined($/<spaces>{' '}), 'Inner hash no capture value 1');
ok($/<spaces>{' '}:exists, 'Inner hash capture key 2');
ok(!defined($/<spaces>{' '}), 'Inner hash no capture value 2');
ok($/<spaces>{"\t"}:exists, 'Inner hash capture key 3');
ok(!defined($/<spaces>{"\t"}), 'Inner hash no capture value 3');
ok($/<spaces>.keys == 3, 'Inner hash no extra captures');
regex spaces { @<spaces>=[\s+] }
ok(" a b\tc" ~~ m/%<chars>=( <spaces> (\S+))+/, 'Subrule hash capture');
ok($/<chars>{'a'}:exists, 'Outer subrule hash capture key 1');
ok(!defined($/<chars><a>), 'Outer subrule hash no capture value 1');
ok($/<chars>{'b'}:exists, 'Outer subrule hash capture key 2');
ok(!defined($/<chars><b>), 'Outer subrule hash no capture value 2');
ok($/<chars>{'c'}:exists, 'Outer subrule hash capture key 3');
ok(!defined($/<chars><c>), 'Outer subrule hash no capture value 3');
ok($/<chars>.keys == 3, 'Outer subrule hash no extra captures');
is($/<spaces>, "\t", 'Final subrule hash capture');
ok(" a b\tc" ~~ m/%<chars>=( %<spaces>=[<?spaces>] (\S+))+/, 'Nested subrule hash multicapture');
ok($/<chars>{'a'}:exists, 'Outer rule nested hash key multicapture');
ok(!defined($/<chars><a>), 'Outer rule nested hash value multicapture');
ok($/<chars>{'b'}:exists, 'Outer rule nested hash key multicapture');
ok(!defined($/<chars><b>), 'Outer rule nested hash value multicapture');
ok($/<chars>{'c'}:exists, 'Outer rule nested hash key multicapture');
ok(!defined($/<chars><c>), 'Outer rule nested hash value multicapture');
ok($/<chars>.keys == 3, 'Outer subrule hash no extra multicaptures');
ok($/<spaces>{' '}:exists, 'Inner rule nested hash key multicapture');
ok(!defined($/<spaces>{' '}), 'Inner rule nested hash value multicapture');
ok($/<spaces>{' '}:exists, 'Inner rule nested hash key multicapture');
ok(!defined($/<spaces>{' '}), 'Inner rule nested hash value multicapture');
ok($/<spaces>{"\t"}:exists, 'Inner rule nested hash key multicapture');
ok(!defined($/<spaces>{"\t"}), 'Inner rule nested hash value multicapture');
ok($/<spaces>.keys == 3, 'Inner subrule hash no extra multicaptures');
ok(" a b\tc" ~~ m/%<chars>=( (<?spaces>) (\S+))+/, 'Nested multiple hash capture');
is($/<chars>{' '}, 'a', 'Outer rule nested hash value multicapture');
is($/<chars>{' '}, 'b', 'Outer rule nested hash value multicapture');
is($/<chars>{"\t"}, 'c', 'Outer rule nested hash value multicapture');
ok($/<chars>.keys == 3, 'Outer subrule hash no extra multicaptures');
my %bases = ();
ok("Gattaca" ~~ m:i/ %bases=(A|C|G|T)+ /, 'All your bases...');
ok(%bases{'a'}:exists, 'a key');
ok(!defined(%bases<a>), 'No a value');
ok(%bases{'c'}:exists, 'c key');
ok(!defined(%bases<c>), 'No c value');
ok(!%bases{'g'}:exists, 'No g key');
ok(%bases{'G'}:exists, 'G key');
ok(!defined(%bases<G>), 'No G value');
ok(%bases{'t'}:exists, 't key');
ok(!defined(%bases<t>), 'No t value');
ok(%bases.keys == 4, 'No other bases');
%bases = ();
my %aca = ('aca' => 1);;
ok("Gattaca" ~~ m:i/ %bases=(A|C|G|T)**{4} (%aca) /, 'Hash interpolation');
ok(%bases{'a'}:exists, 'a key');
ok(!defined(%bases<a>), 'No a value');
ok(!%bases{'c'}:exists, 'No c key');
ok(!%bases{'g'}:exists, 'No g key');
ok(%bases{'G'}:exists, 'G key');
ok(!defined(%bases<G>), 'No G value');
ok(%bases{'t'}:exists, 't key');
ok(!defined(%bases<t>), 'No t value');
ok(%bases.keys == 3, 'No other bases');
is("$1", "aca", 'Trailing aca');
# vim: expandtab shiftwidth=4