Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 162 lines (132 sloc) 7.356 kb
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 159 160 161
use v6;
use Test;

=begin pod

This file was originally derived from the perl5 CPAN module Perl6::Rules,
version 0.3 (12 Apr 2004), file t/hash_cap.t.

=end pod

plan 116;

#?pugs emit force_todo(1..49,51..99,101..108,111..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: ft=perl6
Something went wrong with that request. Please try again.