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