re.pm: Add /aa support
authorKarl Williamson <public@khwilliamson.com>
Fri, 11 Feb 2011 17:22:53 +0000 (10:22 -0700)
committerKarl Williamson <public@khwilliamson.com>
Mon, 14 Feb 2011 15:41:39 +0000 (08:41 -0700)
ext/re/re.pm
ext/re/t/reflags.t

index 0193e6a..eb53455 100644 (file)
@@ -4,7 +4,7 @@ package re;
 use strict;
 use warnings;
 
-our $VERSION     = "0.17";
+our $VERSION     = "0.18";
 our @ISA         = qw(Exporter);
 our @EXPORT_OK   = ('regmust',
                     qw(is_regexp regexp_pattern
@@ -29,6 +29,7 @@ my %reflags = (
     l => 1,
     u => 2,
     a => 3,
+    aa => 4,
 );
 
 sub setcolor {
@@ -144,7 +145,8 @@ sub bits {
        } elsif ($s =~ s/^\///) {
            my $reflags = $^H{reflags} || 0;
            my $seen_charset;
-           for(split//, $s) {
+           while ($s =~ m/( aa | . )/gx) {
+                $_ = $1;
                if (/[adul]/) {
                    if ($on) {
                        if ($seen_charset) {
@@ -155,6 +157,12 @@ sub bits {
                                 .qq 'are exclusive'
                                 );
                             }
+                            elsif ($seen_charset eq 'a') {
+                                Carp::carp(
+                                qq 'The "a" flag may only appear twice if '
+                                .qq 'adjacent, like "aa"'
+                                );
+                            }
                             else {
                                 Carp::carp(
                                 qq 'The "$seen_charset" flag may not appear '
index a0b89d5..343a117 100644 (file)
@@ -10,9 +10,9 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 48;
+use Test::More tests => 58;
 
-my @flags = qw( a d l u );
+my @flags = qw( a d l u aa );
 
 use re '/i';
 ok "Foo" =~ /foo/, 'use re "/i"';
@@ -127,13 +127,32 @@ no re '/x';
       $w = "";
       eval "use re '/$i$j'";
       if ($i eq $j) {
-        like $w, qr/The \"$i\" flag may not appear twice/,
-            "warning with use re \"/$i$i\"";
+        if ($i eq 'a') {
+          is ($w, "", "no warning with use re \"/aa\", $w");
+        }
+        else {
+            like $w, qr/The \"$i\" flag may not appear twice/,
+              "warning with use re \"/$i$i\"";
+        }
       }
       else {
-        like $w, qr/The "$i" and "$j" flags are exclusive/,
-          "warning with eval \"use re \"/$i$j\"";
+        if ($j =~ /$i/) {
+          # If one is a subset of the other, re.pm uses the longest one.
+          like $w, qr/The "$j" and "$i" flags are exclusive/,
+            "warning with eval \"use re \"/$j$i\"";
+        }
+        else {
+          like $w, qr/The "$i" and "$j" flags are exclusive/,
+            "warning with eval \"use re \"/$i$j\"";
+        }
       }
     }
   }
+
+  $w = "";
+  eval "use re '/axa'";
+  like $w, qr/The "a" flag may only appear twice if adjacent, like "aa"/,
+    "warning with eval \"use re \"/axa\"";
+
+
 }