1#!./perl
2
3BEGIN {
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        require 'loc_tools.pl';
10}
11
12use strict;
13
14use Test::More tests => 74;
15
16my @flags = qw( a d l u );
17
18use re '/i';
19ok "Foo" =~ /foo/, 'use re "/i"';
20ok "Foo" =~ /(??{'foo'})/, 'use re "/i" (??{})';
21no re '/i';
22ok "Foo" !~ /foo/, 'no re "/i"';
23ok "Foo" !~ /(??{'foo'})/, 'no re "/i" (??{})';
24use re '/x';
25ok "foo" =~ / foo /, 'use re "/x"';
26ok "foo" =~ / (??{' foo '}) /, 'use re "/x" (??{})';
27like " ", qr/[a b]/, 'use re "/x" [a b]';
28no re '/x';
29ok "foo" !~ / foo /, 'no re "/x"';
30ok "foo" !~ /(??{' foo '})/, 'no re "/x" (??{})';
31ok "foo" !~ / (??{'foo'}) /, 'no re "/x" (??{})';
32use re '/xx';
33ok "foo" =~ / foo /, 'use re "/xx"';
34ok "foo" =~ / (??{' foo '}) /, 'use re "/xx" (??{})';
35unlike " ", qr/[a b]/, 'use re "/xx" [a b] # Space in [] gobbled up';
36no re '/xx';
37ok "foo" !~ / foo /, 'no re "/xx"';
38ok "foo" !~ /(??{' foo '})/, 'no re "/xx" (??{})';
39ok "foo" !~ / (??{'foo'}) /, 'no re "/xx" (??{})';
40use re '/s';
41ok "\n" =~ /./, 'use re "/s"';
42ok "\n" =~ /(??{'.'})/, 'use re "/s" (??{})';
43no re '/s';
44ok "\n" !~ /./, 'no re "/s"';
45ok "\n" !~ /(??{'.'})/, 'no re "/s" (??{})';
46use re '/m';
47ok "\nfoo" =~ /^foo/, 'use re "/m"';
48ok "\nfoo" =~ /(??{'^'})foo/, 'use re "/m" (??{})';
49no re '/m';
50ok "\nfoo" !~ /^foo/, 'no re "/m"';
51ok "\nfoo" !~ /(??{'^'})foo/, 'no re "/m" (??{})';
52
53use re '/xism';
54ok qr// =~ /(?=.*x)(?=.*i)(?=.*s)(?=.*m)/, 'use re "/multiple"';
55no re '/ix';
56ok qr// =~ /(?!.*x)(?!.*i)(?=.*s)(?=.*m)/, 'no re "/i" only turns off /ix';
57no re '/sm';
58
59{
60  use re '/x';
61  ok 'frelp' =~ /f r e l p/, "use re '/x' in a lexical scope"
62}
63ok 'f r e l p' =~ /f r e l p/,
64 "use re '/x' turns off when it drops out of scope";
65
66{
67  use re '/i';
68  ok "Foo" =~ /foo/, 'use re "/i"';
69  no re;
70  ok "Foo" !~ /foo/, "bare 'no re' reverts to no /i";
71  use re '/u';
72  my $nbsp = chr utf8::unicode_to_native(0xa0);
73  ok $nbsp =~ /\s/, 'nbsp matches \\s under /u';
74  no re;
75  ok $nbsp !~ /\s/, "bare 'no re' reverts to /d";
76}
77
78SKIP: {
79  skip "no locale support", 7 unless locales_enabled('CTYPE');
80  use locale;
81  use re '/u';
82  is qr//, '(?^u:)', 'use re "/u" with active locale';
83  no re '/u';
84  is qr//, '(?^l:)', 'no re "/u" reverts to /l with locale in scope';
85  no re '/l';
86  is qr//, '(?^l:)', 'no re "/l" is a no-op with locale in scope';
87  use re '/d';
88  is qr//, '(?^:)', 'use re "/d" with locale in scope';
89  no re '/l';
90  no re '/u';
91  is qr//, '(?^:)',
92    'no re "/l" and "/u" are no-ops when not on (locale scope)';
93  no re "/d";
94  is qr//, '(?^l:)', 'no re "/d" reverts to /l with locale in scope';
95  use re "/u";
96  no re "/d";
97  is qr//, '(?^u:)', 'no re "/d" is a no-op when not on (locale scope)';
98}
99
100{
101  use feature "unicode_strings";
102  use re '/d';
103  is qr//, '(?^:)', 'use re "/d" in Unicode scope';
104  no re '/d';
105  is qr//, '(?^u:)', 'no re "/d" reverts to /u in Unicode scope';
106  no re '/u';
107  is qr//, '(?^u:)', 'no re "/u" is a no-op in Unicode scope';
108  no re '/d';
109  is qr//, '(?^u:)', 'no re "/d" is a no-op when not on';
110  use re '/u';
111  no feature 'unicode_strings';
112  is qr//, '(?^u:)', 'use re "/u" is not tied to unicode_strings feature';
113}
114
115use re '/u';
116is qr//, '(?^u:)', 'use re "/u"';
117no re '/u';
118is qr//, '(?^:)', 'no re "/u" reverts to /d';
119no re '/u';
120is qr//, '(?^:)', 'no re "/u" is a no-op when not on';
121no re '/d';
122is qr//, '(?^:)', 'no re "/d" is a no-op when not on';
123
124{
125  local $SIG{__WARN__} = sub {
126   ok $_[0] =~ /Unknown regular expression flag "\x{100}"/,
127       "warning with unknown regexp flags in use re '/flags'"
128  };
129  import re "/\x{100}"
130}
131
132# use re '/flags' in combination with explicit flags
133use re '/xi';
134ok "A\n\n" =~ / a.$/sm, 'use re "/xi" in combination with explicit /sm';
135{
136  use re '/u';
137  is qr//d, '(?^ix:)', 'explicit /d in re "/u" scope';
138  use re '/d';
139  is qr//u, '(?^uix:)', 'explicit /u in re "/d" scope';
140}
141no re '/x';
142
143# Verify one and two a's work
144use re '/ia';
145is qr//, '(?^ai:)', 'use re "/ia"';
146no re '/ia';
147is qr//, '(?^:)', 'no re "/ia"';
148use re '/aai';
149is qr//, '(?^aai:)', 'use re "/aai"';
150no re '/aai';
151is qr//, '(?^:)', 'no re "/aai"';
152
153# use re "/adul" combinations
154{
155  my $w;
156  local $SIG{__WARN__} = sub { $w = shift };
157  for my $i (@flags) {
158    for my $j (@flags) {
159      $w = "";
160      eval "use re '/$i$j'";
161      if ($i eq $j) {
162        if ($i eq 'a') {
163          is ($w, "", "no warning with use re \"/aa\", $w");
164        }
165        else {
166            like $w, qr/The \"$i\" flag may not appear twice/,
167              "warning with use re \"/$i$i\"";
168        }
169      }
170      else {
171        if ($j =~ /$i/) {
172          # If one is a subset of the other, re.pm uses the longest one.
173          like $w, qr/The "$j" and "$i" flags are exclusive/,
174            "warning with eval \"use re \"/$j$i\"";
175        }
176        else {
177          like $w, qr/The "$i" and "$j" flags are exclusive/,
178            "warning with eval \"use re \"/$i$j\"";
179        }
180      }
181    }
182  }
183
184  $w = "";
185  eval "use re '/amaa'";
186  like $w, qr/The "a" flag may only appear a maximum of twice/,
187    "warning with eval \"use re \"/amaa\"";
188
189  $w = "";
190  eval "use re '/xamaxx'";
191  like $w, qr/The "x" flag may only appear a maximum of twice/,
192    "warning with eval \"use re \"/xamaxx\"";
193
194}
195