From d30277c7df69b4aca40edeb2ae3bf9bb529b01e8 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 31 May 2017 13:08:33 -0600 Subject: [PATCH] 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. --- t/re/reg_mesg.t | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index b80b692..42e42b1 100644 --- 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 { -- 1.8.3.1