Commit | Line | Data |
---|---|---|
19842e53 RGS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
72e9e8b1 | 9 | plan tests => 38; |
768bc71f RGS |
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 | ||
72e9e8b1 | 26 | cmp_ok( $^R, '==', 8, '..$^R after ab =~ ab?' ); |
768bc71f RGS |
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)' ); | |
72e9e8b1 | 34 | cmp_ok( $^R, '==', 12, '..$^R after ab =~ ab? (3)' ); |
768bc71f RGS |
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 | ||
72e9e8b1 RGS |
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 | } |