Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 162 lines (132 sloc) 7.356 kb
8105ed2 [t] and [t/spec]
moritz authored
1 use v6;
2 use Test;
3
4 =begin pod
5
6 This file was originally derived from the perl5 CPAN module Perl6::Rules,
7 version 0.3 (12 Apr 2004), file t/hash_cap.t.
8
9 =end pod
10
11 plan 116;
12
13 #?pugs emit force_todo(1..49,51..99,101..108,111..116);
14
15 # L<S05/Hash aliasing/An alias can also be specified using a hash>
16
17 ok(" a b\tc" ~~ m/%<chars>=( \s+ \S+ )/, 'Named unrepeated hash capture');
18 ok($/<chars>{' a'}:exists, 'One key captured');
19 ok(!defined($/<chars>{' a'}), 'One value undefined');
20 ok($/<chars>.keys == 1, 'No extra unrepeated captures');
21
22 ok(" a b\tc" ~~ m/%<chars>=( \s+ \S+ )+/, 'Named simple hash capture');
23 ok($/<chars>{' a'}:exists, 'First simple key captured');
24 ok(!defined($/<chars>{' a'}), 'First simple value undefined');
25 ok($/<chars>{' b'}:exists, 'Second simple key captured');
26 ok(!defined($/<chars>{' b'}), 'Second simple value undefined');
27 ok($/<chars>{"\tc"}:exists, 'Third simple key captured');
28 ok(!defined($/<chars>{"\tc"}), 'Third simple value undefined');
29 ok($/<chars>.keys == 3, 'No extra simple captures');
30
31 ok(" a b\tc" ~~ m/%<first>=( \s+ \S+ )+ %<last>=( \s+ \S+)+/, 'Sequential simple hash capture');
32 ok($/<first>{' a'}:exists, 'First sequential key captured');
33 ok(!defined($/<first>{' a'}), 'First sequential value undefined');
34 ok($/<first>{' b'}:exists, 'Second sequential key captured');
35 ok(!defined($/<first>{' b'}), 'Second sequential value undefined');
36 ok($/<last>{"\tc"}:exists, 'Third sequential key captured');
37 ok(!defined($/<last>{"\tc"}), 'Third sequential value undefined');
38 ok($/<first>.keys == 2, 'No extra first sequential captures');
39 ok($/<last>.keys == 1, 'No extra last sequential captures');
40
41 ok("abcxyd" ~~ m/a %<foo>=(.(.))+ d/, 'Repeated nested hash capture');
42 ok($/<foo>{'c'}:exists, 'Nested key 1 captured');
43 ok(!defined($/<foo><c>), 'No nested value 1 captured');
44 ok($/<foo>{'y'}:exists, 'Nested key 2 captured');
45 ok(!defined($/<foo><y>), 'No nested value 2 captured');
46 ok($/<foo>.keys == 2, 'No extra nested captures');
47
48 ok("abcd" ~~ m/a %<foo>=(.(.)) d/, 'Unrepeated nested hash capture');
49 ok($/<foo>{'c'}:exists, 'Unrepeated key captured');
50 ok(!defined($/<foo><c>), 'Unrepeated value not captured');
51 ok($/<foo>.keys == 1, 'No extra unrepeated nested captures');
52
53 ok("abcd" ~~ m/a %<foo>=((.)(.)) d/, 'Unrepeated nested hash multicapture');
54 ok($/<foo>{'b'}:exists, 'Unrepeated key multicaptured');
55 ok(~$/<foo><b>, 'c', 'Unrepeated value not multicaptured');
56 ok($/<foo>.keys == 1, 'No extra unrepeated nested multicaptures');
57
58 ok("abcxyd" ~~ m/a %<foo>=((.)(.))+ d/, 'Repeated nested hash multicapture');
59 ok($/<foo>{'b'}:exists, 'Nested key 1 multicaptured');
60 ok($/<foo><b>, 'c', 'Nested value 1 multicaptured');
61 ok($/<foo>{'x'}:exists, 'Nested key 2 multicaptured');
62 ok($/<foo><x>, 'y', 'Nested value 2 multicaptured');
63 ok($/<foo>.keys == 2, 'No extra nested multicaptures');
64
65 our %foo;
66 ok("abcxyd" ~~ m/a %foo=(.(.))+ d/, 'Package hash capture');
67 ok(%foo{'c'}:exists, 'Package hash key 1 captured');
68 ok(!defined(%foo<c>), 'Package hash value 1 not captured');
69 ok(%foo{'y'}:exists, 'Package hash key 2 captured');
70 ok(!defined(%foo<y>), 'Package hash value 2 not captured');
71 ok(%foo.keys == 2, 'No extra package hash captures');
72
73 regex two {..}
74
75 ok("abcd" ~~ m/a %<foo>=[<two>] d/, 'Compound hash capture');
76 is($/<two>, "bc", 'Implicit subrule variable captured');
77 ok($/<foo>.keys == 0, 'Explicit hash variable not captured');
78
79 ok(" a b\tc" ~~ m/%<chars>=( %<spaces>=[\s+] (\S+))+/, 'Nested multihash capture');
80 ok($/<chars>{'a'}:exists, 'Outer hash capture key 1');
81 ok(!defined($/<chars><a>), 'Outer hash no capture value 1');
82 ok($/<chars>{'b'}:exists, 'Outer hash capture key 2');
83 ok(!defined($/<chars><b>), 'Outer hash no capture value 2');
84 ok($/<chars>{'c'}:exists, 'Outer hash capture key 3');
85 ok(!defined($/<chars><c>), 'Outer hash no capture value 3');
86 ok($/<chars>.keys == 3, 'Outer hash no extra captures');
87
88 ok($/<spaces>{' '}:exists, 'Inner hash capture key 1');
89 ok(!defined($/<spaces>{' '}), 'Inner hash no capture value 1');
90 ok($/<spaces>{' '}:exists, 'Inner hash capture key 2');
91 ok(!defined($/<spaces>{' '}), 'Inner hash no capture value 2');
92 ok($/<spaces>{"\t"}:exists, 'Inner hash capture key 3');
93 ok(!defined($/<spaces>{"\t"}), 'Inner hash no capture value 3');
94 ok($/<spaces>.keys == 3, 'Inner hash no extra captures');
95
96 regex spaces { @<spaces>=[\s+] }
97
98 ok(" a b\tc" ~~ m/%<chars>=( <spaces> (\S+))+/, 'Subrule hash capture');
99
100 ok($/<chars>{'a'}:exists, 'Outer subrule hash capture key 1');
101 ok(!defined($/<chars><a>), 'Outer subrule hash no capture value 1');
102 ok($/<chars>{'b'}:exists, 'Outer subrule hash capture key 2');
103 ok(!defined($/<chars><b>), 'Outer subrule hash no capture value 2');
104 ok($/<chars>{'c'}:exists, 'Outer subrule hash capture key 3');
105 ok(!defined($/<chars><c>), 'Outer subrule hash no capture value 3');
106 ok($/<chars>.keys == 3, 'Outer subrule hash no extra captures');
107 is($/<spaces>, "\t", 'Final subrule hash capture');
108
109
110 ok(" a b\tc" ~~ m/%<chars>=( %<spaces>=[<?spaces>] (\S+))+/, 'Nested subrule hash multicapture');
111 ok($/<chars>{'a'}:exists, 'Outer rule nested hash key multicapture');
112 ok(!defined($/<chars><a>), 'Outer rule nested hash value multicapture');
113 ok($/<chars>{'b'}:exists, 'Outer rule nested hash key multicapture');
114 ok(!defined($/<chars><b>), 'Outer rule nested hash value multicapture');
115 ok($/<chars>{'c'}:exists, 'Outer rule nested hash key multicapture');
116 ok(!defined($/<chars><c>), 'Outer rule nested hash value multicapture');
117 ok($/<chars>.keys == 3, 'Outer subrule hash no extra multicaptures');
118
119 ok($/<spaces>{' '}:exists, 'Inner rule nested hash key multicapture');
120 ok(!defined($/<spaces>{' '}), 'Inner rule nested hash value multicapture');
121 ok($/<spaces>{' '}:exists, 'Inner rule nested hash key multicapture');
122 ok(!defined($/<spaces>{' '}), 'Inner rule nested hash value multicapture');
123 ok($/<spaces>{"\t"}:exists, 'Inner rule nested hash key multicapture');
124 ok(!defined($/<spaces>{"\t"}), 'Inner rule nested hash value multicapture');
125 ok($/<spaces>.keys == 3, 'Inner subrule hash no extra multicaptures');
126
127 ok(" a b\tc" ~~ m/%<chars>=( (<?spaces>) (\S+))+/, 'Nested multiple hash capture');
128 is($/<chars>{' '}, 'a', 'Outer rule nested hash value multicapture');
129 is($/<chars>{' '}, 'b', 'Outer rule nested hash value multicapture');
130 is($/<chars>{"\t"}, 'c', 'Outer rule nested hash value multicapture');
131 ok($/<chars>.keys == 3, 'Outer subrule hash no extra multicaptures');
132
133 my %bases = ();
134 ok("Gattaca" ~~ m:i/ %bases=(A|C|G|T)+ /, 'All your bases...');
135 ok(%bases{'a'}:exists, 'a key');
136 ok(!defined(%bases<a>), 'No a value');
137 ok(%bases{'c'}:exists, 'c key');
138 ok(!defined(%bases<c>), 'No c value');
139 ok(!%bases{'g'}:exists, 'No g key');
140 ok(%bases{'G'}:exists, 'G key');
141 ok(!defined(%bases<G>), 'No G value');
142 ok(%bases{'t'}:exists, 't key');
143 ok(!defined(%bases<t>), 'No t value');
144 ok(%bases.keys == 4, 'No other bases');
145
146 %bases = ();
147 my %aca = ('aca' => 1);;
148 ok("Gattaca" ~~ m:i/ %bases=(A|C|G|T)**{4} (%aca) /, 'Hash interpolation');
149 ok(%bases{'a'}:exists, 'a key');
150 ok(!defined(%bases<a>), 'No a value');
151 ok(!%bases{'c'}:exists, 'No c key');
152 ok(!%bases{'g'}:exists, 'No g key');
153 ok(%bases{'G'}:exists, 'G key');
154 ok(!defined(%bases<G>), 'No G value');
155 ok(%bases{'t'}:exists, 't key');
156 ok(!defined(%bases<t>), 'No t value');
157 ok(%bases.keys == 3, 'No other bases');
158 is("$1", "aca", 'Trailing aca');
159
160
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
161 # vim: ft=perl6
Something went wrong with that request. Please try again.