Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 151 lines (121 sloc) 4.55 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/exhaustive.t.
8
cd74518 [t/spec] smartlink and done_testing for exhaustive.t (the plan was incor...
moritz authored
9 # L<S05/Modifiers/:exhaustive>
8105ed2 [t] and [t/spec]
moritz authored
10
cd74518 [t/spec] smartlink and done_testing for exhaustive.t (the plan was incor...
moritz authored
11 =end pod
8105ed2 [t] and [t/spec]
moritz authored
12
13 #?pugs emit force_todo(2,3,5,6,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42);
14
15 my $str = "abrAcadAbbra";
16
17 my @expected = (
18 [ 0 => 'abrAcadAbbra' ],
19 [ 0 => 'abrAcadA' ],
20 [ 0 => 'abrAca' ],
21 [ 0 => 'abrA' ],
22 [ 3 => 'AcadAbbra' ],
23 [ 3 => 'AcadA' ],
24 [ 3 => 'Aca' ],
25 [ 5 => 'adAbbra' ],
26 [ 5 => 'adA' ],
27 [ 7 => 'Abbra' ],
28 );
29
30 for (1..2) -> $rep {
31 ok($str ~~ m:i:exhaustive/ a .+ a /, "Repeatable every-way match ($rep)" );
32
33 ok(@$/ == @expected, "Correct number of matches ($rep)" );
34 my %expected; %expected{map {$_[1]}, @expected} = (1) x @expected;
35 my %position; %position{map {$_[1]}, @expected} = map {$_[0]}, @expected;
36 for (@$/) {
37 ok( %expected{$_}, "Matched '$_' ($rep)" );
38 ok( %position{$_} == $_.pos, "At correct position of '$_' ($rep)" );
7fa2c2d Moritz Lenz clean up and fudge exhaustive.t a little
moritz authored
39 #?rakudo emit #
8105ed2 [t] and [t/spec]
moritz authored
40 %expected{$_} :delete;
7fa2c2d Moritz Lenz clean up and fudge exhaustive.t a little
moritz authored
41 #?rakudo emit %expected.delete($_)
8105ed2 [t] and [t/spec]
moritz authored
42 }
43 ok(%expected.keys == 0, "No matches missed ($rep)" );
44 }
45
46 ok(!( "abcdefgh" ~~ m:exhaustive/ a .+ a / ), 'Failed every-way match');
47 ok(@$/ == 0, 'No matches');
48
49 ok($str ~~ m:ex:i/ a (.+) a /, 'Capturing every-way match');
50
51 ok(@$/ == @expected, 'Correct number of capturing matches');
52 my %expected; %expected{map {$_[1]}, @expected} = (1) x @expected;
53
7fa2c2d Moritz Lenz clean up and fudge exhaustive.t a little
moritz authored
54 for @($/) {
8105ed2 [t] and [t/spec]
moritz authored
55 ok( %expected{$_}, "Capture matched '$_'" );
56 ok( $_[1] = substr($_[0],1,-1), "Captured within '$_'" );
57 %expected{$_} :delete;
58 }
59
60 my @adj = <time>;
61 my @noun = <time flies arrow>;
62 my @verb = <time flies like>;
63 my @art = <an>;
64 my @prep = <like>;
65
66 ok( "time flies like an arrow" ~~
67 m:s:ex/^ [
68 $<adj> = (@adj)
69 $<subj> = (@noun)
70 $<verb> = (@verb)
71 $<art> = (@art)
72 $<obj> = (@noun)
73 |
74 $<subj> = (@noun)
75 $<verb> = (@verb)
76 $<prep> = (@prep)
77 $<art> = (@art)
78 $<obj> = (@noun)
79 |
80 $<verb> = (@verb)
81 $<obj> = (@noun)
82 $<prep> = (@prep)
83 $<art> = (@art)
84 $<noun> = (@noun)
85 ]
86 /, 'Multiple capturing');
87
88 is(~$/[0]<adj>, 'time', 'Capture 0 adj');
89 is(~$/[0]<subj>, 'flies', 'Capture 0 subj');
90 is(~$/[0]<verb>, 'like', 'Capture 0 verb');
91 is(~$/[0]<art>, 'an', 'Capture 0 art');
92 is(~$/[0]<obj>, 'arrow', 'Capture 0 obj');
93
94 is(~$/[1]<subj>, 'time', 'Capture 1 subj');
95 is(~$/[1]<verb>, 'flies', 'Capture 1 verb');
96 is(~$/[1]<prep>, 'like', 'Capture 1 prep');
97 is(~$/[1]<art>, 'an', 'Capture 1 art');
98 is(~$/[1]<obj>, 'arrow', 'Capture 1 obj');
99
100 is(~$/[2]<verb>, 'time', 'Capture 2 verb');
101 is(~$/[2]<obj>, 'flies', 'Capture 2 obj');
102 is(~$/[2]<prep>, 'like', 'Capture 2 prep');
103 is(~$/[2]<art>, 'an', 'Capture 2 art');
104 is(~$/[2]<noun>, 'arrow', 'Capture 2 noun');
105
106
107 regex subj { <?noun> }
108 regex obj { <?noun> }
109 regex noun { time | flies | arrow }
110 regex verb { flies | like | time }
111 regex adj { time }
112 regex art { an? }
113 regex prep { like }
114
115 skip_rest("XXX - infinite loop"); exit;
116
117 ok("time flies like an arrow" ~~
118 m:s:ex/^ [ <adj> <subj> <verb> <art> <obj>
119 | <subj> <verb> <prep> <art> <noun>
120 | <verb> <obj> <prep> <art> <noun>
121 ]
122 /,
123 "Any with capturing rules"
124 );
125
126 is(~$/[0]<adj>, 'time', 'Rule capture 0 adj');
127 is(~$/[0]<subj>, 'flies', 'Rule capture 0 subj');
128 is(~$/[0]<verb>, 'like', 'Rule capture 0 verb');
129 is(~$/[0]<art>, 'an', 'Rule capture 0 art');
130 is(~$/[0]<obj>, 'arrow', 'Rule capture 0 obj');
131
132 is(~$/[1]<subj>, 'time', 'Rule capture 1 subj');
133 is(~$/[1]<verb>, 'flies', 'Rule capture 1 verb');
134 is(~$/[1]<prep>, 'like', 'Rule capture 1 prep');
135 is(~$/[1]<art>, 'an', 'Rule capture 1 art');
136 is(~$/[1]<noun>, 'arrow', 'Rule capture 1 noun');
137
138 is(~$/[2]<verb>, 'time', 'Rule capture 2 verb');
139 is(~$/[2]<obj>, 'flies', 'Rule capture 2 obj');
140 is(~$/[2]<prep>, 'like', 'Rule capture 2 prep');
141 is(~$/[2]<art>, 'an', 'Rule capture 2 art');
142 is(~$/[2]<noun>, 'arrow', 'Rule capture 2 noun');
143
144
145 ok(!( "fooooo" ~~ m:exhaustive { s o+ } ), 'Subsequent failed any match...');
146 ok(@$/ == 0, '...leaves @$/ empty');
147
e76dd4c Moritz Lenz s/done_testing/done/ as per recent S24 changes
moritz authored
148 done();
cd74518 [t/spec] smartlink and done_testing for exhaustive.t (the plan was incor...
moritz authored
149
150 # vim: ft=perl6
Something went wrong with that request. Please try again.