1use Perl6::Rules; 2use Test::Simple 'no_plan'; 3 4# BUG: Captures in subrules that are captured cause 5# memory faults under 5.8.3 6# This problem has been reported. 7# 8# rule dotdot { (.)(.) }; 9 10rule dotdot { .. }; 11 12ok("zzzabcdefzzz" =~ m/(a.)<dotdot>(..)/, "Match"); 13ok($0, "Matched"); 14ok($0 eq "abcdef", "Captured"); 15ok($0->[0] eq 'abcdef', '$0->[0]'); 16ok($0->[1] eq 'ab', '$0->[1]'); 17ok($1 eq 'ab', '$1'); 18ok($0->[2] eq 'ef', '$0->[2]'); 19ok($2 eq 'ef', '$2'); 20ok(!defined($0->[3]), 'no $0->[3]'); 21ok(!defined($3), 'no $3'); 22ok(!defined($0->{dotdot}), 'no $0->{dotdot}'); 23 24ok("zzzabcdefzzz" =~ m/(a.)<?dotdot>(..)/, "Match"); 25ok($0, "Matched"); 26ok($0 eq "abcdef", "Captured"); 27ok($0->[0] eq 'abcdef', '$0->[0]'); 28ok($0->[1] eq 'ab', '$0->[1]'); 29ok($1 eq 'ab', '$1'); 30ok($0->[2] eq 'ef', '$0->[2]'); 31ok($2 eq 'ef', '$2'); 32ok(!defined($0->[3]), '$0->[3]'); 33ok(!defined($3), '$3'); 34ok($0->{dotdot} eq 'cd', '$0->{dotdot}'); 35ok($0->{dotdot}[0] eq 'cd', '$0->{dotdot}[0]'); 36 37# BUG: See above. 38# ok($0->{dotdot}[1] eq 'c', '$0->{dotdot}[1]'); 39# ok($0->{dotdot}[2] eq 'd', '$0->{dotdot}[2]'); 40 41ok(!defined($0->{dotdot}[3]), '$0->{dotdot}[3]'); 42 43ok( "abcd" =~ m/(a(b(c))(d))/, "Nested captured" ); 44ok( $1 eq "abcd", 'Nested $1' ); 45ok( $2 eq "bc", 'Nested $2' ); 46ok( $3 eq "c", 'Nested $3' ); 47ok( $4 eq "d", 'Nested $4' ); 48 49ok( "bookkeeper" =~ m/(((\w)$3)+)/, "Backreference" ); 50ok( $1 eq 'ookkee', Captured ); 51ok( $2 eq 'ee', Captured ); 52 53rule single { o | k | e }; 54 55ok( "bookkeeper" =~ m/<?single> ($?single)/, "Named backref" ); 56ok( $0->{single} eq 'o', "Named capture" ); 57ok( $1 eq 'o', 'Backref capture'); 58 59ok( "bookkeeper" =~ m/(<single>) ($1)/, "Positional backref" ); 60ok( $1 eq 'o', "Named capture" ); 61ok( $2 eq 'o', 'Backref capture'); 62 63ok( "bokeper" !~ m/(<single>) ($1)/, "Failed positional backref" ); 64ok( "bokeper" !~ m/<?single> ($?single)/, "Failed named backref" ); 65 66ok( "\$1" eq '$'.'1', 'Non-translation of non-interpolated "\\$1"' ); 67ok( '$1' eq '$'.'1', 'Non-translation of non-interpolated \'$1\'' ); 68ok( q($1) eq '$'.'1', 'Non-translation of non-interpolated q($1)' ); 69ok( q{$1} eq '$'.'1', 'Non-translation of non-interpolated q{$1}' ); 70ok( q[$1] eq '$'.'1', 'Non-translation of non-interpolated q[$1]' ); 71ok( q<$1> eq '$'.'1', 'Non-translation of non-interpolated q<$1>' ); 72ok( q<$1 <<<>>>> eq '$'.'1 <<<>>>', 'Non-translation of nested q<$1>' ); 73ok( q/$1/ eq '$'.'1', 'Non-translation of non-interpolated q/$1/' ); 74ok( q!$1! eq '$'.'1', 'Non-translation of non-interpolated q!$1!' ); 75ok( q|$1| eq '$'.'1', 'Non-translation of non-interpolated q|$1|' ); 76ok( q#$1# eq '$'.'1', 'Non-translation of non-interpolated q#$1#' ); 77 78 79grammar English { rule name { john } } 80grammar French { rule name { jean } } 81grammar Russian { rule name { ivan } } 82 83ok( "john" =~ m/<?English.name> | <?French.name> | <?Russian.name>/, "English name" ); 84ok( $0 eq "john", "Match is john"); 85ok( $0 ne "jean", "Match isn't jean"); 86ok( $0->{name} eq "john", "Name is john"); 87 88ok( "jean" =~ m/<?English.name> | <?French.name> | <?Russian.name>/, "French name" ); 89ok( $0 eq "jean", "Match is jean"); 90ok( $0->{name} eq "jean", "Name is jean"); 91 92ok( "ivan" =~ m/<?English.name> | <?French.name> | <?Russian.name>/, "Russian name" ); 93ok( $0 eq "ivan", "Match is ivan"); 94ok( $0->{name} eq "ivan", "Name is ivan"); 95 96# BUG: See above. 97# 98# rule name { <?English.name> | <?French.name> | <?Russian.name> } 99# 100# ok( "john" =~ m/<?name>/, "English metaname" ); 101# ok( $0 eq "john", "Metaname match is john"); 102# ok( $0 ne "jean", "Metaname match isn't jean"); 103# ok( $0->{name} eq "john", "Metaname is john"); 104# ok( $0->{name}{name} eq "john", "Metaname name is john"); 105 106