re.pm: Forbid things like /dd, /uu

This is so they can perhaps be used in the future by Perl.

The test file is refactored to test these more comprehensively, adding tests
for the recently added /a.

diff --git a/ext/re/re.pm b/ext/re/re.pm
index 850b948..0193e6a 100644 (file)
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -147,12 +147,20 @@ sub bits {
            for(split//, $s) {
                if (/[adul]/) {
                    if ($on) {
-                       if ($seen_charset && $seen_charset ne $_) {
+                       if ($seen_charset) {
                            require Carp;
-                           Carp::carp(
-                             qq 'The "$seen_charset" and "$_" flags '
-                            .qq 'are exclusive'
-                           );
+                            if ($seen_charset ne $_) {
+                                Carp::carp(
+                                qq 'The "$seen_charset" and "$_" flags '
+                                .qq 'are exclusive'
+                                );
+                            }
+                            else {
+                                Carp::carp(
+                                qq 'The "$seen_charset" flag may not appear '
+                                .qq 'twice'
+                                );
+                            }
                        }
                        $^H{reflags_charset} = $reflags{$_};
                        $seen_charset = $_;

diff --git a/ext/re/t/reflags.t b/ext/re/t/reflags.t
index ef16e24..a0b89d5 100644 (file)
--- a/ext/re/t/reflags.t
+++ b/ext/re/t/reflags.t
@@ -10,7 +10,9 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 38;
+use Test::More tests => 48;
+
+my @flags = qw( a d l u );
 
 use re '/i';
 ok "Foo" =~ /foo/, 'use re "/i"';
@@ -116,23 +118,22 @@ ok "A\n\n" =~ / a.$/sm, 'use re "/xi" in combination with explicit /sm';
 }
 no re '/x';
 
-# use re "/dul" combinations
+# use re "/adul" combinations
 {
-  my $w = '';
+  my $w;
   local $SIG{__WARN__} = sub { $w = shift };
-  eval "use re '/dd'";
-  is $w, "", 'no warning with eval "use re "/dd"';
-  eval "use re '/uu'";
-  is $w, "", 'no warning with eval "use re "/uu"';
-  eval "use re '/ll'";
-  is $w, "", 'no warning with eval "use re "/ll"';
-  eval "use re '/dl'";
-  like $w, qr/The "d" and "l" flags are exclusive/,
-    'warning with eval "use re "/dl"';
-  eval "use re '/du'";
-  like $w, qr/The "d" and "u" flags are exclusive/,
-   'warning with eval "use re "/du"';
-  eval "use re '/ul'";
-  like $w, qr/The "u" and "l" flags are exclusive/,
-   'warning with use re "/ul"';
+  for my $i (@flags) {
+    for my $j (@flags) {
+      $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\"";
+      }
+      else {
+        like $w, qr/The "$i" and "$j" flags are exclusive/,
+          "warning with eval \"use re \"/$i$j\"";
+      }
+    }
+  }
 }