This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/re/reg_mesg.t: Add override of warning default on/off
[perl5.git] / t / re / reg_mesg.t
index b80b692..42e42b1 100644 (file)
@@ -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 {