This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
test that code within /(?{})/ etc is optimised
[perl5.git] / ext / re / t / reflags.t
1 #!./perl
2
3 BEGIN {
4         require Config;
5         if (($Config::Config{'extensions'} !~ /\bre\b/) ){
6                 print "1..0 # Skip -- Perl configured without re module\n";
7                 exit 0;
8         }
9 }
10
11 use strict;
12
13 use Test::More tests => 53;
14
15 my @flags = qw( a d l u );
16
17 use re '/i';
18 ok "Foo" =~ /foo/, 'use re "/i"';
19 no re '/i';
20 ok "Foo" !~ /foo/, 'no re "/i"';
21 use re '/x';
22 ok "foo" =~ / foo /, 'use re "/x"';
23 no re '/x';
24 ok "foo" !~ / foo /, 'no re "/x"';
25 use re '/s';
26 ok "\n" =~ /./, 'use re "/s"';
27 no re '/s';
28 ok "\n" !~ /./, 'no re "/s"';
29 use re '/m';
30 ok "\nfoo" =~ /^foo/, 'use re "/m"';
31 no re '/m';
32 ok "\nfoo" !~ /^foo/, 'no re "/m"';
33
34 use re '/xism';
35 ok qr// =~ /(?=.*x)(?=.*i)(?=.*s)(?=.*m)/, 'use re "/multiple"';
36 no re '/ix';
37 ok qr// =~ /(?!.*x)(?!.*i)(?=.*s)(?=.*m)/, 'no re "/i" only turns off /ix';
38 no re '/sm';
39
40 {
41   use re '/x';
42   ok 'frelp' =~ /f r e l p/, "use re '/x' in a lexical scope"
43 }
44 ok 'f r e l p' =~ /f r e l p/,
45  "use re '/x' turns off when it drops out of scope";
46
47 SKIP: {
48   if (
49       !$Config::Config{d_setlocale}
50    || $Config::Config{ccflags} =~ /\bD?NO_LOCALE\b/
51   ) {
52     skip "no locale support", 7
53   }
54   use locale;
55   use re '/u';
56   is qr//, '(?^u:)', 'use re "/u" with active locale';
57   no re '/u';
58   is qr//, '(?^l:)', 'no re "/u" reverts to /l with locale in scope';
59   no re '/l';
60   is qr//, '(?^l:)', 'no re "/l" is a no-op with locale in scope';
61   use re '/d';
62   is qr//, '(?^:)', 'use re "/d" with locale in scope';
63   no re '/l';
64   no re '/u';
65   is qr//, '(?^:)',
66     'no re "/l" and "/u" are no-ops when not on (locale scope)';
67   no re "/d";
68   is qr//, '(?^l:)', 'no re "/d" reverts to /l with locale in scope';
69   use re "/u";
70   no re "/d";
71   is qr//, '(?^u:)', 'no re "/d" is a no-op when not on (locale scope)';
72 }
73
74 {
75   use feature "unicode_strings";
76   use re '/d';
77   is qr//, '(?^:)', 'use re "/d" in Unicode scope';
78   no re '/d';
79   is qr//, '(?^u:)', 'no re "/d" reverts to /u in Unicode scope';
80   no re '/u';
81   is qr//, '(?^u:)', 'no re "/u" is a no-op in Unicode scope';
82   no re '/d';
83   is qr//, '(?^u:)', 'no re "/d" is a no-op when not on';
84   use re '/u';
85   no feature 'unicode_strings';
86   is qr//, '(?^u:)', 'use re "/u" is not tied to unicode_strings feature';
87 }
88
89 use re '/u';
90 is qr//, '(?^u:)', 'use re "/u"';
91 no re '/u';
92 is qr//, '(?^:)', 'no re "/u" reverts to /d';
93 no re '/u';
94 is qr//, '(?^:)', 'no re "/u" is a no-op when not on';
95 no re '/d';
96 is qr//, '(?^:)', 'no re "/d" is a no-op when not on';
97
98 {
99   local $SIG{__WARN__} = sub {
100    ok $_[0] =~ /Unknown regular expression flag "\x{100}"/,
101        "warning with unknown regexp flags in use re '/flags'"
102   };
103   import re "/\x{100}"
104 }
105
106 # use re '/flags' in combination with explicit flags
107 use re '/xi';
108 ok "A\n\n" =~ / a.$/sm, 'use re "/xi" in combination with explicit /sm';
109 {
110   use re '/u';
111   is qr//d, '(?^ix:)', 'explicit /d in re "/u" scope';
112   use re '/d';
113   is qr//u, '(?^uix:)', 'explicit /u in re "/d" scope';
114 }
115 no re '/x';
116
117 # Verify one and two a's work
118 use re '/ia';
119 is qr//, '(?^ai:)', 'use re "/ia"';
120 no re '/ia';
121 is qr//, '(?^:)', 'no re "/ia"';
122 use re '/aai';
123 is qr//, '(?^aai:)', 'use re "/aai"';
124 no re '/aai';
125 is qr//, '(?^:)', 'no re "/aai"';
126
127 # use re "/adul" combinations
128 {
129   my $w;
130   local $SIG{__WARN__} = sub { $w = shift };
131   for my $i (@flags) {
132     for my $j (@flags) {
133       $w = "";
134       eval "use re '/$i$j'";
135       if ($i eq $j) {
136         if ($i eq 'a') {
137           is ($w, "", "no warning with use re \"/aa\", $w");
138         }
139         else {
140             like $w, qr/The \"$i\" flag may not appear twice/,
141               "warning with use re \"/$i$i\"";
142         }
143       }
144       else {
145         if ($j =~ /$i/) {
146           # If one is a subset of the other, re.pm uses the longest one.
147           like $w, qr/The "$j" and "$i" flags are exclusive/,
148             "warning with eval \"use re \"/$j$i\"";
149         }
150         else {
151           like $w, qr/The "$i" and "$j" flags are exclusive/,
152             "warning with eval \"use re \"/$i$j\"";
153         }
154       }
155     }
156   }
157
158   $w = "";
159   eval "use re '/axaa'";
160   like $w, qr/The "a" flag may only appear a maximum of twice/,
161     "warning with eval \"use re \"/axaa\"";
162
163
164 }