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