[perl5.git] / t / re / pat_re_eval.t

#!./perl
#
# This is a home for regular expression tests that don't fit into
# the format supported by re/regexp.t.  If you want to add a test
# that does fit that format, add it to re/re_tests, not here.

use strict;
use warnings;
use 5.010;


sub run_tests;

$| = 1;


BEGIN {
    chdir 't' if -d 't';
    @INC = ('../lib','.');
    do "re/ReTest.pl" or die $@;
}


plan tests => 123;  # Update this when adding/deleting tests.

run_tests() unless caller;

#
# Tests start here.
#
sub run_tests {
    {
        local $Message =  "Call code from qr //";
        local $_ = 'var="foo"';
        $a = qr/(?{++$b})/;
        $b = 7;
        ok /$a$a/ && $b eq '9';

        my $c="$a";
        ok /$a$a/ && $b eq '11';

        undef $@;
        eval {/$c/};
        ok $@ && $@ =~ /not allowed at runtime/;

        use re "eval";
        /$a$c$a/;
        iseq $b, '14';

        our $lex_a = 43;
        our $lex_b = 17;
        our $lex_c = 27;
        my $lex_res = ($lex_b =~ qr/$lex_b(?{ $lex_c = $lex_a++ })/);

        iseq $lex_res, 1;
        iseq $lex_a, 44;
        iseq $lex_c, 43;

        no re "eval";
        undef $@;
        my $match = eval { /$a$c$a/ };
        ok $@ && $@ =~ /Eval-group not allowed/ && !$match;
        iseq $b, '14';

        $lex_a = 2;
        $lex_a = 43;
        $lex_b = 17;
        $lex_c = 27;
        $lex_res = ($lex_b =~ qr/17(?{ $lex_c = $lex_a++ })/);

        iseq $lex_res, 1;
        iseq $lex_a, 44;
        iseq $lex_c, 43;

    }

    {
        our $a = bless qr /foo/ => 'Foo';
        ok 'goodfood' =~ $a,     "Reblessed qr // matches";
        iseq $a, '(?-xism:foo)', "Reblessed qr // stringifies";
        my $x = "\x{3fe}";
        my $z = my $y = "\317\276";  # Byte representation of $x
        $a = qr /$x/;
        ok $x =~ $a, "UTF-8 interpolation in qr //";
        ok "a$a" =~ $x, "Stringified qr // preserves UTF-8";
        ok "a$x" =~ /^a$a\z/, "Interpolated qr // preserves UTF-8";
        ok "a$x" =~ /^a(??{$a})\z/,
                        "Postponed interpolation of qr // preserves UTF-8";
        {
            local $BugId = '17776';
            iseq length qr /##/x, 12, "## in qr // doesn't corrupt memory";
        }
        {
            use re 'eval';
            ok "$x$x" =~ /^$x(??{$x})\z/,
               "Postponed UTF-8 string in UTF-8 re matches UTF-8";
            ok "$y$x" =~ /^$y(??{$x})\z/,
               "Postponed UTF-8 string in non-UTF-8 re matches UTF-8";
            ok "$y$x" !~ /^$y(??{$y})\z/,
               "Postponed non-UTF-8 string in non-UTF-8 re doesn't match UTF-8";
            ok "$x$x" !~ /^$x(??{$y})\z/,
               "Postponed non-UTF-8 string in UTF-8 re doesn't match UTF-8";
            ok "$y$y" =~ /^$y(??{$y})\z/,
               "Postponed non-UTF-8 string in non-UTF-8 re matches non-UTF8";
            ok "$x$y" =~ /^$x(??{$y})\z/,
               "Postponed non-UTF-8 string in UTF-8 re matches non-UTF8";

            $y = $z;  # Reset $y after upgrade.
            ok "$x$y" !~ /^$x(??{$x})\z/,
               "Postponed UTF-8 string in UTF-8 re doesn't match non-UTF-8";
            ok "$y$y" !~ /^$y(??{$x})\z/,
               "Postponed UTF-8 string in non-UTF-8 re doesn't match non-UTF-8";
        }
    }


    {
        use re 'eval';
        local $Message = 'Test if $^N and $+ work in (?{{})';
        our @ctl_n = ();
        our @plus = ();
        our $nested_tags;
        $nested_tags = qr{
            <
               ((\w)+)
               (?{
                       push @ctl_n, (defined $^N ? $^N : "undef");
                       push @plus, (defined $+ ? $+ : "undef");
               })
            >
            (??{$nested_tags})*
            </\s* \w+ \s*>
        }x;


        my $c = 0;
        for my $test (
            # Test structure:
            #  [ Expected result, Regex, Expected value(s) of $^N, Expected value(s) of $+ ]
            [ 1, qr#^$nested_tags$#, "bla blubb bla", "a b a" ],
            [ 1, qr#^($nested_tags)$#, "bla blubb <bla><blubb></blubb></bla>", "a b a" ],
            [ 1, qr#^(|)$nested_tags$#, "bla blubb bla", "a b a" ],
            [ 1, qr#^(?:|)$nested_tags$#, "bla blubb bla", "a b a" ],
            [ 1, qr#^<(bl|bla)>$nested_tags<(/\1)>$#, "blubb /bla", "b /bla" ],
            [ 1, qr#(??{"(|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
            [ 1, qr#^(??{"(bla|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
            [ 1, qr#^(??{"(|)"})(??{$nested_tags})$#, "bla blubb undef", "a b undef" ],
            [ 1, qr#^(??{"(?:|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
            [ 1, qr#^((??{"(?:bla|)"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
            [ 1, qr#^((??{"(?!)?"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
            [ 1, qr#^((??{"(?:|<(/?bla)>)"}))((??{$nested_tags}))\1$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
            [ 0, qr#^((??{"(?!)"}))?((??{$nested_tags}))(?!)$#, "bla blubb undef", "a b undef" ],

        ) { #"#silence vim highlighting
            $c++;
            @ctl_n = ();
            @plus = ();
            my $match = (("<bla><blubb></blubb></bla>" =~ $test->[1]) ? 1 : 0);
            push @ctl_n, (defined $^N ? $^N : "undef");
            push @plus, (defined $+ ? $+ : "undef");
            ok($test->[0] == $match, "match $c");
            if ($test->[0] != $match) {
              # unset @ctl_n and @plus
              @ctl_n = @plus = ();
            }
            iseq("@ctl_n", $test->[2], "ctl_n $c");
            iseq("@plus", $test->[3], "plus $c");
        }
    }

    {
        use re 'eval';
        local $BugId = '56194';

        our $f;
        local $f;
        $f = sub {
            defined $_[0] ? $_[0] : "undef";
        };

        ok("123" =~ m/^(\d)(((??{1 + $^N})))+$/);

        our @ctl_n;
        our @plus;

        my $re  = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))*(?{$^N})#;
        my $re2 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))*(?{$^N})(|a(b)c|def)(??{"$^R"})#;
        my $re3 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})){2}(?{$^N})(|a(b)c|def)(??{"$^R"})#;
        our $re5;
        local $re5 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})){2}(?{$^N})#;
        my $re6 = qr#(??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})#;
        my $re7 = qr#(??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})#;
        my $re8 = qr/(\d+)/;
        my $c = 0;
        for my $test (
             # Test structure:
             #  [
             #    String to match
             #    Regex too match
             #    Expected values of $^N
             #    Expected values of $+
             #    Expected values of $1, $2, $3, $4 and $5
             #  ]
             [
                  "1233",
                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(??{$^N})$#,
                  "1 2 3 3",
                  "1 2 3 3",
                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
             ],
             [
                  "1233",
                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(abc|def|)?(??{$+})$#,
                  "1 2 3 3",
                  "1 2 3 3",
                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
             ],
             [
                  "1233",
                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(|abc|def)?(??{$+})$#,
                  "1 2 3 3",
                  "1 2 3 3",
                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
             ],
             [
                  "1233",
                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(abc|def|)?(??{$^N})$#,
                  "1 2 3 3",
                  "1 2 3 3",
                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
             ],
             [
                  "1233",
                  qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(|abc|def)?(??{$^N})$#,
                  "1 2 3 3",
                  "1 2 3 3",
                  "\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
              ],
              [
                  "123abc3",
                   qr#^($re)(|a(b)c|def)(??{$^R})$#,
                   "1 2 3 abc",
                   "1 2 3 b",
                   "\$1 = 123, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
              ],
              [
                  "123abc3",
                   qr#^($re2)$#,
                   "1 2 3 123abc3",
                   "1 2 3 b",
                   "\$1 = 123abc3, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
              ],
              [
                  "123abc3",
                   qr#^($re3)$#,
                   "1 2 123abc3",
                   "1 2 b",
                   "\$1 = 123abc3, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
              ],
              [
                  "123abc3",
                   qr#^(??{$re5})(|abc|def)(??{"$^R"})$#,
                   "1 2 abc",
                   "1 2 abc",
                   "\$1 = abc, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef",
              ],
              [
                  "123abc3",
                   qr#^(??{$re5})(|a(b)c|def)(??{"$^R"})$#,
                   "1 2 abc",
                   "1 2 b",
                   "\$1 = abc, \$2 = b, \$3 = undef, \$4 = undef, \$5 = undef",
              ],
              [
                  "1234",
                   qr#^((\d+)((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1}))((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1}))((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1})))$#,
                   "1234 123 12 1 2 3 1234",
                   "1234 123 12 1 2 3 4",
                   "\$1 = 1234, \$2 = 1, \$3 = 2, \$4 = 3, \$5 = 4",
              ],
              [
                   "1234556",
                   qr#^(\d+)($re6)($re6)($re6)$re6(($re6)$re6)$#,
                   "1234556 123455 12345 1234 123 12 1 2 3 4 4 5 56",
                   "1234556 123455 12345 1234 123 12 1 2 3 4 4 5 5",
                   "\$1 = 1, \$2 = 2, \$3 = 3, \$4 = 4, \$5 = 56",
              ],
              [
                  "12345562",
                   qr#^((??{$re8}))($re7)($re7)($re7)$re7($re7)($re7(\2))$#,
                   "12345562 1234556 123455 12345 1234 123 12 1 2 3 4 4 5 62",
                   "12345562 1234556 123455 12345 1234 123 12 1 2 3 4 4 5 2",
                   "\$1 = 1, \$2 = 2, \$3 = 3, \$4 = 4, \$5 = 5",
              ],
        ) {
            $c++;
            @ctl_n = ();
            @plus = ();
            undef $^R;
            my $match = $test->[0] =~ $test->[1];
            my $str = join(", ", '$1 = '.$f->($1), '$2 = '.$f->($2), '$3 = '.$f->($3), '$4 = '.$f->($4),'$5 = '.$f->($5));
            push @ctl_n, $f->($^N);
            push @plus, $f->($+);
            ok($match, "match $c");
            if (not $match) {
                # unset $str, @ctl_n and @plus
                $str = "";
                @ctl_n = @plus = ();
            }
            iseq("@ctl_n", $test->[2], "ctl_n $c");
            iseq("@plus", $test->[3], "plus $c");
            iseq($str, $test->[4], "str $c");
        }
        SKIP: {
            if ($] le '5.010') {
                skip "test segfaults on perl < 5.10", 4;
            }

            @ctl_n = ();
            @plus = ();

            our $re4;
            local $re4 = qr#(1)((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1})){2}(?{$^N})(|abc|def)(??{"$^R"})#;
            undef $^R;
            my $match = "123abc3" =~ m/^(??{$re4})$/;
            my $str = join(", ", '$1 = '.$f->($1), '$2 = '.$f->($2), '$3 = '.$f->($3), '$4 = '.$f->($4),'$5 = '.$f->($5),'$^R = '.$f->($^R));
            push @ctl_n, $f->($^N);
            push @plus, $f->($+);
            ok($match);
            if (not $match) {
                # unset $str
                @ctl_n = ();
                @plus = ();
                $str = "";
            }
            iseq("@ctl_n", "1 2 undef");
            iseq("@plus", "1 2 undef");
            iseq($str, "\$1 = undef, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef, \$^R = undef");
       }
    }

} # End of sub run_tests

1;
Commit	Line	Data
0f289c68 YO	1	#!./perl
	2	#
	3	# This is a home for regular expression tests that don't fit into
	4	# the format supported by re/regexp.t. If you want to add a test
	5	# that does fit that format, add it to re/re_tests, not here.
	6
	7	use strict;
	8	use warnings;
	9	use 5.010;
	10
	11
	12	sub run_tests;
	13
	14	$\| = 1;
	15
	16
	17	BEGIN {
	18	chdir 't' if -d 't';
	19	@INC = ('../lib','.');
	20	do "re/ReTest.pl" or die $@;
	21	}
	22
	23
	24	plan tests => 123; # Update this when adding/deleting tests.
	25
	26	run_tests() unless caller;
	27
	28	#
	29	# Tests start here.
	30	#
	31	sub run_tests {
	32	{
	33	local $Message = "Call code from qr //";
	34	local $_ = 'var="foo"';
	35	$a = qr/(?{++$b})/;
	36	$b = 7;
	37	ok /$a$a/ && $b eq '9';
	38
	39	my $c="$a";
	40	ok /$a$a/ && $b eq '11';
	41
	42	undef $@;
	43	eval {/$c/};
	44	ok $@ && $@ =~ /not allowed at runtime/;
	45
	46	use re "eval";
	47	/$a$c$a/;
	48	iseq $b, '14';
	49
	50	our $lex_a = 43;
	51	our $lex_b = 17;
	52	our $lex_c = 27;
	53	my $lex_res = ($lex_b =~ qr/$lex_b(?{ $lex_c = $lex_a++ })/);
	54
	55	iseq $lex_res, 1;
	56	iseq $lex_a, 44;
	57	iseq $lex_c, 43;
	58
	59	no re "eval";
	60	undef $@;
	61	my $match = eval { /$a$c$a/ };
	62	ok $@ && $@ =~ /Eval-group not allowed/ && !$match;
	63	iseq $b, '14';
	64
65	$lex_a = 2;
66	$lex_a = 43;
67	$lex_b = 17;
68	$lex_c = 27;
69	$lex_res = ($lex_b =~ qr/17(?{ $lex_c = $lex_a++ })/);
70
71	iseq $lex_res, 1;
72	iseq $lex_a, 44;
73	iseq $lex_c, 43;
74
75	}
76
77	{
78	our $a = bless qr /foo/ => 'Foo';
79	ok 'goodfood' =~ $a, "Reblessed qr // matches";
80	iseq $a, '(?-xism:foo)', "Reblessed qr // stringifies";
81	my $x = "\x{3fe}";
82	my $z = my $y = "\317\276"; # Byte representation of $x
83	$a = qr /$x/;
84	ok $x =~ $a, "UTF-8 interpolation in qr //";
85	ok "a$a" =~ $x, "Stringified qr // preserves UTF-8";
86	ok "a$x" =~ /^a$a\z/, "Interpolated qr // preserves UTF-8";
87	ok "a$x" =~ /^a(??{$a})\z/,
88	"Postponed interpolation of qr // preserves UTF-8";
89	{
90	local $BugId = '17776';
91	iseq length qr /##/x, 12, "## in qr // doesn't corrupt memory";
92	}
93	{
94	use re 'eval';
95	ok "$x$x" =~ /^$x(??{$x})\z/,
96	"Postponed UTF-8 string in UTF-8 re matches UTF-8";
97	ok "$y$x" =~ /^$y(??{$x})\z/,
98	"Postponed UTF-8 string in non-UTF-8 re matches UTF-8";
99	ok "$y$x" !~ /^$y(??{$y})\z/,
100	"Postponed non-UTF-8 string in non-UTF-8 re doesn't match UTF-8";
101	ok "$x$x" !~ /^$x(??{$y})\z/,
102	"Postponed non-UTF-8 string in UTF-8 re doesn't match UTF-8";
103	ok "$y$y" =~ /^$y(??{$y})\z/,
104	"Postponed non-UTF-8 string in non-UTF-8 re matches non-UTF8";
105	ok "$x$y" =~ /^$x(??{$y})\z/,
106	"Postponed non-UTF-8 string in UTF-8 re matches non-UTF8";
107
108	$y = $z; # Reset $y after upgrade.
109	ok "$x$y" !~ /^$x(??{$x})\z/,
110	"Postponed UTF-8 string in UTF-8 re doesn't match non-UTF-8";
111	ok "$y$y" !~ /^$y(??{$x})\z/,
112	"Postponed UTF-8 string in non-UTF-8 re doesn't match non-UTF-8";
113	}
114	}
115
116
117	{
118	use re 'eval';
119	local $Message = 'Test if $^N and $+ work in (?{{})';
120	our @ctl_n = ();
121	our @plus = ();
122	our $nested_tags;
123	$nested_tags = qr{
124	<
125	((\w)+)
126	(?{
127	push @ctl_n, (defined $^N ? $^N : "undef");
128	push @plus, (defined $+ ? $+ : "undef");
129	})
130	>
131	(??{$nested_tags})*
132	</\s* \w+ \s*>
133	}x;
134
135
136	my $c = 0;
137	for my $test (
138	# Test structure:
139	# [ Expected result, Regex, Expected value(s) of $^N, Expected value(s) of $+ ]
140	[ 1, qr#^$nested_tags$#, "bla blubb bla", "a b a" ],
141	[ 1, qr#^($nested_tags)$#, "bla blubb <bla><blubb></blubb></bla>", "a b a" ],
142	[ 1, qr#^(\|)$nested_tags$#, "bla blubb bla", "a b a" ],
143	[ 1, qr#^(?:\|)$nested_tags$#, "bla blubb bla", "a b a" ],
144	[ 1, qr#^<(bl\|bla)>$nested_tags<(/\1)>$#, "blubb /bla", "b /bla" ],
145	[ 1, qr#(??{"(\|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
146	[ 1, qr#^(??{"(bla\|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
147	[ 1, qr#^(??{"(\|)"})(??{$nested_tags})$#, "bla blubb undef", "a b undef" ],
148	[ 1, qr#^(??{"(?:\|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
149	[ 1, qr#^((??{"(?:bla\|)"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
150	[ 1, qr#^((??{"(?!)?"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
151	[ 1, qr#^((??{"(?:\|<(/?bla)>)"}))((??{$nested_tags}))\1$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
152	[ 0, qr#^((??{"(?!)"}))?((??{$nested_tags}))(?!)$#, "bla blubb undef", "a b undef" ],
153
154	) { #"#silence vim highlighting
155	$c++;
156	@ctl_n = ();
157	@plus = ();
158	my $match = (("<bla><blubb></blubb></bla>" =~ $test->[1]) ? 1 : 0);
159	push @ctl_n, (defined $^N ? $^N : "undef");
160	push @plus, (defined $+ ? $+ : "undef");
161	ok($test->[0] == $match, "match $c");
162	if ($test->[0] != $match) {
163	# unset @ctl_n and @plus
164	@ctl_n = @plus = ();
165	}
166	iseq("@ctl_n", $test->[2], "ctl_n $c");
167	iseq("@plus", $test->[3], "plus $c");
168	}
169	}
170
171	{
172	use re 'eval';
173	local $BugId = '56194';
174
175	our $f;
176	local $f;
177	$f = sub {
178	defined $_[0] ? $_[0] : "undef";
179	};
180
181	ok("123" =~ m/^(\d)(((??{1 + $^N})))+$/);
182
183	our @ctl_n;
184	our @plus;
185
186	my $re = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))*(?{$^N})#;
187	my $re2 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))*(?{$^N})(\|a(b)c\|def)(??{"$^R"})#;
188	my $re3 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})){2}(?{$^N})(\|a(b)c\|def)(??{"$^R"})#;
189	our $re5;
190	local $re5 = qr#(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})){2}(?{$^N})#;
191	my $re6 = qr#(??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})#;
192	my $re7 = qr#(??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1})#;
193	my $re8 = qr/(\d+)/;
194	my $c = 0;
195	for my $test (
196	# Test structure:
197	# [
198	# String to match
199	# Regex too match
200	# Expected values of $^N
201	# Expected values of $+
202	# Expected values of $1, $2, $3, $4 and $5
203	# ]
204	[
205	"1233",
206	qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(??{$^N})$#,
207	"1 2 3 3",
208	"1 2 3 3",
209	"\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
210	],
211	[
212	"1233",
213	qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(abc\|def\|)?(??{$+})$#,
214	"1 2 3 3",
215	"1 2 3 3",
216	"\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
217	],
218	[
219	"1233",
220	qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(\|abc\|def)?(??{$+})$#,
221	"1 2 3 3",
222	"1 2 3 3",
223	"\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
224	],
225	[
226	"1233",
227	qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(abc\|def\|)?(??{$^N})$#,
228	"1 2 3 3",
229	"1 2 3 3",
230	"\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
231	],
232	[
233	"1233",
234	qr#^(1)((??{ push @ctl_n, $f->($^N); push @plus, $f->($+); $^N + 1}))+(\|abc\|def)?(??{$^N})$#,
235	"1 2 3 3",
236	"1 2 3 3",
237	"\$1 = 1, \$2 = 3, \$3 = undef, \$4 = undef, \$5 = undef",
238	],
239	[
240	"123abc3",
241	qr#^($re)(\|a(b)c\|def)(??{$^R})$#,
242	"1 2 3 abc",
243	"1 2 3 b",
244	"\$1 = 123, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
245	],
246	[
247	"123abc3",
248	qr#^($re2)$#,
249	"1 2 3 123abc3",
250	"1 2 3 b",
251	"\$1 = 123abc3, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
252	],
253	[
254	"123abc3",
255	qr#^($re3)$#,
256	"1 2 123abc3",
257	"1 2 b",
258	"\$1 = 123abc3, \$2 = 1, \$3 = 3, \$4 = abc, \$5 = b",
259	],
260	[
261	"123abc3",
262	qr#^(??{$re5})(\|abc\|def)(??{"$^R"})$#,
263	"1 2 abc",
264	"1 2 abc",
265	"\$1 = abc, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef",
266	],
267	[
268	"123abc3",
269	qr#^(??{$re5})(\|a(b)c\|def)(??{"$^R"})$#,
270	"1 2 abc",
271	"1 2 b",
272	"\$1 = abc, \$2 = b, \$3 = undef, \$4 = undef, \$5 = undef",
273	],
274	[
275	"1234",
276	qr#^((\d+)((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1}))((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1}))((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1})))$#,
277	"1234 123 12 1 2 3 1234",
278	"1234 123 12 1 2 3 4",
279	"\$1 = 1234, \$2 = 1, \$3 = 2, \$4 = 3, \$5 = 4",
280	],
281	[
282	"1234556",
283	qr#^(\d+)($re6)($re6)($re6)$re6(($re6)$re6)$#,
284	"1234556 123455 12345 1234 123 12 1 2 3 4 4 5 56",
285	"1234556 123455 12345 1234 123 12 1 2 3 4 4 5 5",
286	"\$1 = 1, \$2 = 2, \$3 = 3, \$4 = 4, \$5 = 56",
287	],
288	[
289	"12345562",
290	qr#^((??{$re8}))($re7)($re7)($re7)$re7($re7)($re7(\2))$#,
291	"12345562 1234556 123455 12345 1234 123 12 1 2 3 4 4 5 62",
292	"12345562 1234556 123455 12345 1234 123 12 1 2 3 4 4 5 2",
293	"\$1 = 1, \$2 = 2, \$3 = 3, \$4 = 4, \$5 = 5",
294	],
295	) {
296	$c++;
297	@ctl_n = ();
298	@plus = ();
299	undef $^R;
300	my $match = $test->[0] =~ $test->[1];
301	my $str = join(", ", '$1 = '.$f->($1), '$2 = '.$f->($2), '$3 = '.$f->($3), '$4 = '.$f->($4),'$5 = '.$f->($5));
302	push @ctl_n, $f->($^N);
303	push @plus, $f->($+);
304	ok($match, "match $c");
305	if (not $match) {
306	# unset $str, @ctl_n and @plus
307	$str = "";
308	@ctl_n = @plus = ();
309	}
310	iseq("@ctl_n", $test->[2], "ctl_n $c");
311	iseq("@plus", $test->[3], "plus $c");
312	iseq($str, $test->[4], "str $c");
313	}
314	SKIP: {
315	if ($] le '5.010') {
316	skip "test segfaults on perl < 5.10", 4;
317	}
318
319	@ctl_n = ();
320	@plus = ();
321
322	our $re4;
323	local $re4 = qr#(1)((??{push @ctl_n, $f->($^N); push @plus, $f->($+);$^N + 1})){2}(?{$^N})(\|abc\|def)(??{"$^R"})#;
324	undef $^R;
325	my $match = "123abc3" =~ m/^(??{$re4})$/;
326	my $str = join(", ", '$1 = '.$f->($1), '$2 = '.$f->($2), '$3 = '.$f->($3), '$4 = '.$f->($4),'$5 = '.$f->($5),'$^R = '.$f->($^R));
327	push @ctl_n, $f->($^N);
328	push @plus, $f->($+);
329	ok($match);
330	if (not $match) {
331	# unset $str
332	@ctl_n = ();
333	@plus = ();
334	$str = "";
335	}
336	iseq("@ctl_n", "1 2 undef");
337	iseq("@plus", "1 2 undef");
338	iseq($str, "\$1 = undef, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef, \$^R = undef");
339	}
340	}
341
342	} # End of sub run_tests
343
344	1;