Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / rxcode.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 plan tests => 38;
10
11 $^R = undef;
12 like( 'a',  qr/^a(?{1})(?:b(?{2}))?/, 'a =~ ab?' );
13 cmp_ok( $^R, '==', 1, '..$^R after a =~ ab?' );
14
15 $^R = undef;
16 unlike( 'abc', qr/^a(?{3})(?:b(?{4}))$/, 'abc !~ a(?:b)$' );
17 ok( !defined $^R, '..$^R after abc !~ a(?:b)$' );
18
19 $^R = undef;
20 like( 'ab', qr/^a(?{5})b(?{6})/, 'ab =~ ab' );
21 cmp_ok( $^R, '==', 6, '..$^R after ab =~ ab' );
22
23 $^R = undef;
24 like( 'ab', qr/^a(?{7})(?:b(?{8}))?/, 'ab =~ ab?' );
25
26 cmp_ok( $^R, '==', 8, '..$^R after ab =~ ab?' );
27
28 $^R = undef;
29 like( 'ab', qr/^a(?{9})b?(?{10})/, 'ab =~ ab? (2)' );
30 cmp_ok( $^R, '==', 10, '..$^R after ab =~ ab? (2)' );
31
32 $^R = undef;
33 like( 'ab', qr/^(a(?{11})(?:b(?{12})))?/, 'ab =~ (ab)? (3)' );
34 cmp_ok( $^R, '==', 12, '..$^R after ab =~ ab? (3)' );
35
36 $^R = undef;
37 unlike( 'ac', qr/^a(?{13})b(?{14})/, 'ac !~ ab' );
38 ok( !defined $^R, '..$^R after ac !~ ab' );
39
40 $^R = undef;
41 like( 'ac', qr/^a(?{15})(?:b(?{16}))?/, 'ac =~ ab?' );
42 cmp_ok( $^R, '==', 15, '..$^R after ac =~ ab?' );
43
44 my @ar;
45 like( 'ab', qr/^a(?{push @ar,101})(?:b(?{push @ar,102}))?/, 'ab =~ ab? with code push' );
46 cmp_ok( scalar(@ar), '==', 2, '..@ar pushed' );
47 cmp_ok( $ar[0], '==', 101, '..first element pushed' );
48 cmp_ok( $ar[1], '==', 102, '..second element pushed' );
49
50 $^R = undef;
51 unlike( 'a', qr/^a(?{103})b(?{104})/, 'a !~ ab with code push' );
52 ok( !defined $^R, '..$^R after a !~ ab with code push' );
53
54 @ar = ();
55 unlike( 'a', qr/^a(?{push @ar,105})b(?{push @ar,106})/, 'a !~ ab (push)' );
56 cmp_ok( scalar(@ar), '==', 0, '..nothing pushed' );
57
58 @ar = ();
59 unlike( 'abc', qr/^a(?{push @ar,107})b(?{push @ar,108})$/, 'abc !~ ab$ (push)' );
60 cmp_ok( scalar(@ar), '==', 0, '..still nothing pushed' );
61
62 use vars '@var';
63
64 like( 'ab', qr/^a(?{push @var,109})(?:b(?{push @var,110}))?/, 'ab =~ ab? push to package var' );
65 cmp_ok( scalar(@var), '==', 2, '..@var pushed' );
66 cmp_ok( $var[0], '==', 109, '..first element pushed (package)' );
67 cmp_ok( $var[1], '==', 110, '..second element pushed (package)' );
68
69 @var = ();
70 unlike( 'a', qr/^a(?{push @var,111})b(?{push @var,112})/, 'a !~ ab (push package var)' );
71 cmp_ok( scalar(@var), '==', 0, '..nothing pushed (package)' );
72
73 @var = ();
74 unlike( 'abc', qr/^a(?{push @var,113})b(?{push @var,114})$/, 'abc !~ ab$ (push package var)' );
75 cmp_ok( scalar(@var), '==', 0, '..still nothing pushed (package)' );
76
77 {
78     local $^R = undef;
79     ok( 'ac' =~ /^a(?{30})(?:b(?{31})|c(?{32}))?/, 'ac =~ a(?:b|c)?' );
80     ok( $^R == 32, '$^R == 32' );
81 }
82 {
83     local $^R = undef;
84     ok( 'abbb' =~ /^a(?{36})(?:b(?{37})|c(?{38}))+/, 'abbbb =~ a(?:b|c)+' );
85     ok( $^R == 37, '$^R == 37' ) or print "# \$^R=$^R\n";
86 }