This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Get rxcode.t working under minitest
[perl5.git] / t / re / rxcode.t
CommitLineData
19842e53
RGS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
19842e53 5 require './test.pl';
7be3525f
FC
6 @INC = () unless is_miniperl();
7 unshift @INC, '../lib';
19842e53
RGS
8}
9
2d885586 10plan tests => 40;
768bc71f
RGS
11
12$^R = undef;
13like( 'a', qr/^a(?{1})(?:b(?{2}))?/, 'a =~ ab?' );
14cmp_ok( $^R, '==', 1, '..$^R after a =~ ab?' );
15
16$^R = undef;
17unlike( 'abc', qr/^a(?{3})(?:b(?{4}))$/, 'abc !~ a(?:b)$' );
18ok( !defined $^R, '..$^R after abc !~ a(?:b)$' );
19
20$^R = undef;
21like( 'ab', qr/^a(?{5})b(?{6})/, 'ab =~ ab' );
22cmp_ok( $^R, '==', 6, '..$^R after ab =~ ab' );
23
24$^R = undef;
25like( 'ab', qr/^a(?{7})(?:b(?{8}))?/, 'ab =~ ab?' );
26
72e9e8b1 27cmp_ok( $^R, '==', 8, '..$^R after ab =~ ab?' );
768bc71f
RGS
28
29$^R = undef;
30like( 'ab', qr/^a(?{9})b?(?{10})/, 'ab =~ ab? (2)' );
31cmp_ok( $^R, '==', 10, '..$^R after ab =~ ab? (2)' );
32
33$^R = undef;
34like( 'ab', qr/^(a(?{11})(?:b(?{12})))?/, 'ab =~ (ab)? (3)' );
72e9e8b1 35cmp_ok( $^R, '==', 12, '..$^R after ab =~ ab? (3)' );
768bc71f
RGS
36
37$^R = undef;
38unlike( 'ac', qr/^a(?{13})b(?{14})/, 'ac !~ ab' );
39ok( !defined $^R, '..$^R after ac !~ ab' );
40
41$^R = undef;
42like( 'ac', qr/^a(?{15})(?:b(?{16}))?/, 'ac =~ ab?' );
43cmp_ok( $^R, '==', 15, '..$^R after ac =~ ab?' );
44
45my @ar;
46like( 'ab', qr/^a(?{push @ar,101})(?:b(?{push @ar,102}))?/, 'ab =~ ab? with code push' );
47cmp_ok( scalar(@ar), '==', 2, '..@ar pushed' );
48cmp_ok( $ar[0], '==', 101, '..first element pushed' );
49cmp_ok( $ar[1], '==', 102, '..second element pushed' );
50
51$^R = undef;
52unlike( 'a', qr/^a(?{103})b(?{104})/, 'a !~ ab with code push' );
53ok( !defined $^R, '..$^R after a !~ ab with code push' );
54
55@ar = ();
56unlike( 'a', qr/^a(?{push @ar,105})b(?{push @ar,106})/, 'a !~ ab (push)' );
57cmp_ok( scalar(@ar), '==', 0, '..nothing pushed' );
58
59@ar = ();
60unlike( 'abc', qr/^a(?{push @ar,107})b(?{push @ar,108})$/, 'abc !~ ab$ (push)' );
61cmp_ok( scalar(@ar), '==', 0, '..still nothing pushed' );
62
63use vars '@var';
64
65like( 'ab', qr/^a(?{push @var,109})(?:b(?{push @var,110}))?/, 'ab =~ ab? push to package var' );
66cmp_ok( scalar(@var), '==', 2, '..@var pushed' );
67cmp_ok( $var[0], '==', 109, '..first element pushed (package)' );
68cmp_ok( $var[1], '==', 110, '..second element pushed (package)' );
69
70@var = ();
71unlike( 'a', qr/^a(?{push @var,111})b(?{push @var,112})/, 'a !~ ab (push package var)' );
72cmp_ok( scalar(@var), '==', 0, '..nothing pushed (package)' );
73
74@var = ();
75unlike( 'abc', qr/^a(?{push @var,113})b(?{push @var,114})$/, 'abc !~ ab$ (push package var)' );
76cmp_ok( scalar(@var), '==', 0, '..still nothing pushed (package)' );
77
72e9e8b1
RGS
78{
79 local $^R = undef;
80 ok( 'ac' =~ /^a(?{30})(?:b(?{31})|c(?{32}))?/, 'ac =~ a(?:b|c)?' );
81 ok( $^R == 32, '$^R == 32' );
82}
83{
84 local $^R = undef;
85 ok( 'abbb' =~ /^a(?{36})(?:b(?{37})|c(?{38}))+/, 'abbbb =~ a(?:b|c)+' );
86 ok( $^R == 37, '$^R == 37' ) or print "# \$^R=$^R\n";
87}
99543f15
FC
88
89# Broken temporarily by the jumbo re-eval rewrite in 5.17.1; fixed in .6
90{
91 use re 'eval';
92 $x = "(?{})";
93 is eval { "a" =~ /a++(?{})+$x/x } || $@, '1', '/a++(?{})+$code_block/'
94}
2d885586 95
2d885586
FC
96# [perl #78194] $_ in code block aliasing op return values
97"$_" =~ /(?{ is \$_, \$_,
98 '[perl #78194] \$_ == \$_ when $_ aliases "$x"' })/;