Skip to content

Commit

Permalink
Fix and modernize test, add to spectest.data
Browse files Browse the repository at this point in the history 
The test seems to be extremely outdated with traces of early Perl6
design patters. Besides, the test now passes as whole.
  • Loading branch information
@vrurg
vrurg committed Jul 29, 2020
1 parent cd8df27 commit 83b6ce6
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 70 deletions.
135 changes: 65 additions & 70 deletions S05-modifier/exhaustive.t
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
use v6;
use Test;
plan 11;
plan 104;

=begin pod
Expand All @@ -13,47 +13,47 @@ version 0.3 (12 Apr 2004), file t/exhaustive.t.

my $str = "abrAcadAbbra";

my @expected = (
[ 0 => 'abrAcadAbbra' ],
[ 0 => 'abrAcadA' ],
[ 0 => 'abrAca' ],
[ 0 => 'abrA' ],
[ 3 => 'AcadAbbra' ],
[ 3 => 'AcadA' ],
[ 3 => 'Aca' ],
[ 5 => 'adAbbra' ],
[ 5 => 'adA' ],
[ 7 => 'Abbra' ],
);
my @expected =
[ 0, 'abrAcadAbbra' ],
[ 0, 'abrAcadA' ],
[ 0, 'abrAca' ],
[ 0, 'abrA' ],
[ 3, 'AcadAbbra' ],
[ 3, 'AcadA' ],
[ 3, 'Aca' ],
[ 5, 'adAbbra' ],
[ 5, 'adA' ],
[ 7, 'Abbra' ],
;

for (1..2) -> $rep {
ok($str ~~ m:i:exhaustive/ a .+ a /, "Repeatable every-way match ($rep)" );

ok(@$/ == @expected, "Correct number of matches ($rep)" );
my %expected; %expected{map {$_[1]}, @expected} = (1) x @expected;
my %position; %position{map {$_[1]}, @expected} = map {$_[0]}, @expected;
is +@$/, +@expected, "Correct number of matches (pass $rep)";
my %position;
for @expected -> ($pos, $exp) {
%position{$exp} = $pos;
}
for (@$/) {
ok( %expected{$_}, "Matched '$_' ($rep)" );
ok( %position{$_} == $_.pos, "At correct position of '$_' ($rep)" );
#?rakudo emit #
%expected{$_} :delete;
#?rakudo emit %expected{$_}:delete
ok %position{$_}:exists, "Matched '$_' ($rep)";
is .from, %position{$_}, "At correct position of '$_' ($rep)";
%position{$_}:delete;
}
ok(%expected.keys == 0, "No matches missed ($rep)" );
is +%position, 0, "No matches missed ($rep)";
}

ok(!( "abcdefgh" ~~ m:exhaustive/ a .+ a / ), 'Failed every-way match');
ok(@$/ == 0, 'No matches');
nok "abcdefgh" ~~ m:exhaustive/ a .+ a /, 'Failed every-way match';
is +@$/, 0, 'No matches';

ok $str ~~ m:ex:i/ a (.+) a /, 'Capturing every-way match';

ok($str ~~ m:ex:i/ a (.+) a /, 'Capturing every-way match');
is +@$/, +@expected, 'Correct number of capturing matches';

ok(@$/ == @expected, 'Correct number of capturing matches');
my %expected; %expected{map {$_[1]}, @expected} = (1) x @expected;
my %expected = |(@expected.map: { $_[1] => True });

for @($/) {
ok( %expected{$_}, "Capture matched '$_'" );
ok( $_[1] = substr($_[0],1,-1), "Captured within '$_'" );
%expected{$_} :delete;
ok %expected{$_}, "Capture matched '$_'";
is $_[0], substr($_,1,*-1), "Captured within '$_'";
}

my @adj = <time>;
Expand Down Expand Up @@ -103,45 +103,40 @@ is(~$/[2]<art>, 'an', 'Capture 2 art');
is(~$/[2]<noun>, 'arrow', 'Capture 2 noun');


regex subj { <?noun> }
regex obj { <?noun> }
regex noun { time | flies | arrow }
regex verb { flies | like | time }
regex adj { time }
regex art { an? }
regex prep { like }

skip-rest("XXX - infinite loop"); exit;

ok("time flies like an arrow" ~~
m:s:ex/^ [ <adj> <subj> <verb> <art> <obj>
| <subj> <verb> <prep> <art> <noun>
| <verb> <obj> <prep> <art> <noun>
]
/,
"Any with capturing rules"
);

is(~$/[0]<adj>, 'time', 'Rule capture 0 adj');
is(~$/[0]<subj>, 'flies', 'Rule capture 0 subj');
is(~$/[0]<verb>, 'like', 'Rule capture 0 verb');
is(~$/[0]<art>, 'an', 'Rule capture 0 art');
is(~$/[0]<obj>, 'arrow', 'Rule capture 0 obj');

is(~$/[1]<subj>, 'time', 'Rule capture 1 subj');
is(~$/[1]<verb>, 'flies', 'Rule capture 1 verb');
is(~$/[1]<prep>, 'like', 'Rule capture 1 prep');
is(~$/[1]<art>, 'an', 'Rule capture 1 art');
is(~$/[1]<noun>, 'arrow', 'Rule capture 1 noun');

is(~$/[2]<verb>, 'time', 'Rule capture 2 verb');
is(~$/[2]<obj>, 'flies', 'Rule capture 2 obj');
is(~$/[2]<prep>, 'like', 'Rule capture 2 prep');
is(~$/[2]<art>, 'an', 'Rule capture 2 art');
is(~$/[2]<noun>, 'arrow', 'Rule capture 2 noun');


ok(!( "fooooo" ~~ m:exhaustive { s o+ } ), 'Subsequent failed any match...');
ok(@$/ == 0, '...leaves @$/ empty');
my regex noun { time | flies | arrow }
my regex subj { <noun> }
my regex obj { <noun> }
my regex verb { flies | like | time }
my regex adj { time }
my regex art { an? }
my regex prep { like }

#skip-rest("XXX - infinite loop"); exit;

ok "time flies like an arrow" ~~
m:s:ex/^[<adj> <subj> <verb> <art> <obj>|<subj> <verb> <prep> <art> <noun>|<verb> <obj> <prep> <art> <noun>]/,
"Any with capturing rules";

is ~$/[0]<adj>, 'time', 'Rule capture 0 adj';
is ~$/[0]<subj>, 'flies', 'Rule capture 0 subj';
is ~$/[0]<verb>, 'like', 'Rule capture 0 verb';
is ~$/[0]<art>, 'an', 'Rule capture 0 art';
is ~$/[0]<obj>, 'arrow', 'Rule capture 0 obj';

is ~$/[1]<subj>, 'time', 'Rule capture 1 subj';
is ~$/[1]<verb>, 'flies', 'Rule capture 1 verb';
is ~$/[1]<prep>, 'like', 'Rule capture 1 prep';
is ~$/[1]<art>, 'an', 'Rule capture 1 art';
is ~$/[1]<noun>, 'arrow', 'Rule capture 1 noun';

is ~$/[2]<verb>, 'time', 'Rule capture 2 verb';
is ~$/[2]<obj>, 'flies', 'Rule capture 2 obj';
is ~$/[2]<prep>, 'like', 'Rule capture 2 prep';
is ~$/[2]<art>, 'an', 'Rule capture 2 art';
is ~$/[2]<noun>, 'arrow', 'Rule capture 2 noun';


nok "fooooo" ~~ m:exhaustive { s o+ }, 'Subsequent failed any match...';
is +@$/, 0, '...leaves @$/ empty';

# vim: expandtab shiftwidth=4
1 change: 1 addition & 0 deletions spectest.data
View file
Original file line number Diff line number Diff line change
Expand Up @@ -460,6 +460,7 @@ S05-modifier/Perl_6.t
S05-modifier/Perl_7.t
S05-modifier/Perl_8.t
S05-modifier/Perl_9.t
S05-modifier/exhaustive.t
S05-modifier/continue.t
S05-modifier/counted-match.t
S05-modifier/counted.t
Expand Down

0 comments on commit 83b6ce6

Please sign in to comment.