t/re/reg_mesg.t: Add override of warning default on/off

This .t needs an overhaul to more cleanly accommodate the extra tasks it
has been given over the years.  But until then, this is a minimal
enhancement that will be useful in the commit after this one.

This adds the ability to specify that a particular pattern being tested
should generate a message which is raised by default vs one that isn't.
The messages are currently grouped in categories whose default is
determined by the category itself.  This commit avoids having to create
a new category when a message comes along that doesn't quite fit into
the existing ones.

diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index b80b692..42e42b1 100644 (file)
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -106,9 +106,14 @@ my $high_mixed_digit = ('A' lt '0') ? '0' : 'A';
 my $colon_hex = sprintf "%02X", ord(":");
 my $tab_hex = sprintf "%02X", ord("\t");
 
-##
-## Key-value pairs of code/error of code that should have fatal errors.
-##
+# Key-value pairs of strings eval'd as patterns => warn/error messages that
+# they should generate.  In some cases, the value is an array of multiple
+# messages.  Some groups have the message(s) be default on; others, default
+# off.  This can be overridden on an individual key basis by preceding the
+# pattern string with either 'default_on' or 'default_off'
+#
+# The first set are those that should be fatal errors.
+
 my @death =
 (
  '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/[[=foo=]{#}]/',
@@ -673,7 +678,7 @@ for my $strict ("", "use re 'strict';") {
         }
     }
     for (my $i = 0; $i < @death; $i += 2) {
-        my $regex = $death[$i];
+        my $regex = $death[$i] =~ s/ default_ (on | off) //rx;
         my $expect = fixup_expect($death[$i+1], $strict);
         no warnings 'experimental::regex_sets';
         no warnings 'experimental::re_strict';
@@ -736,7 +741,11 @@ for my $strict ("",  "no warnings 'experimental::re_strict'; use re 'strict';")
             $default_on = 1;
         }
         for (my $i = 0; $i < @$ref; $i += 2) {
+            my $this_default_on = $default_on;
             my $regex = $ref->[$i];
+            if ($regex =~ s/ default_ (on | off) //x) {
+                $this_default_on = $1 eq 'on';
+            }
             my @expect = fixup_expect($ref->[$i+1], $strict);
 
             # A length-1 array with an empty warning means no warning gets
@@ -790,7 +799,7 @@ for my $strict ("",  "no warnings 'experimental::re_strict'; use re 'strict';")
                                                         eval "$strict $regex" });
                         # Warning should be on as well if is testing
                         # '(?[...])' which turns on strict
-                        if ($default_on || grep { $_ =~ /\Q(?[/ } @expect ) {
+                        if ($this_default_on || grep { $_ =~ /\Q(?[/ } @expect ) {
                            ok @warns > 0, "... and the warning is on by default";
                         }
                         else {