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