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 }