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