Add warning_is() in test.pl to replace may_not_warn() in ReTest.pl.

warning_is() provides a subset of the functionality of the routine of the same
name in Test::Warn.

diff --git a/t/re/ReTest.pl b/t/re/ReTest.pl
index 41aae3a..fe92010 100644 (file)
--- a/t/re/ReTest.pl
+++ b/t/re/ReTest.pl
@@ -43,13 +43,4 @@ sub must_warn {
     like($w, qr/$pattern/, "Got warning /$pattern/");
 }
 
-sub may_not_warn {
-    my ($code, $name) = @_;
-    my $w;
-    local $SIG {__WARN__} = sub {$w .= join "" => @_};
-    use warnings 'all';
-    ref $code ? &$code : eval $code;
-    is($w, undef, $name) or diag("Got warning '$w'");
-}
-
 1;

diff --git a/t/re/pat.t b/t/re/pat.t
index 2640fdc..c85ea81 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -962,7 +962,8 @@ sub run_tests {
 
     {
         my $message = '"1" is not \s';
-        may_not_warn sub {ok ("1\n" x 102 !~ /^\s*\n/m, $message)}, "$message (did not warn)";
+        warning_is(sub {unlike("1\n" x 102, qr/^\s*\n/m, $message)},
+                  undef, "$message (did not warn)");
     }
 
     {

diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index 98bd08e..7a06ac6 100644 (file)
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -468,8 +468,8 @@ sub run_tests {
         my $SIGMA = "\N{GREEK CAPITAL LETTER SIGMA}";
         my $char  = "\N{COMBINING GREEK PERISPOMENI}";
 
-        may_not_warn sub {unlike("_:$char:_", qr/_:$SIGMA:_/i, $message)},
-           'Did not warn [change a5961de5f4215b5c]';
+        warning_is(sub {unlike("_:$char:_", qr/_:$SIGMA:_/i, $message)}, undef,
+                  'Did not warn [change a5961de5f4215b5c]');
     }
 
     {
@@ -679,7 +679,8 @@ sub run_tests {
         my $s = "\x{e4}\x{100}";
         # This is not expected to match: the point is that
         # neither should we get "Malformed UTF-8" warnings.
-        may_not_warn sub {$s =~ /\G(.+?)\n/gcs}, "No 'Malformed UTF-8' warning";
+        warning_is(sub {$s =~ /\G(.+?)\n/gcs}, undef,
+                  "No 'Malformed UTF-8' warning");
 
         my @c;
         push @c => $1 while $s =~ /\G(.)/gs;

diff --git a/t/test.pl b/t/test.pl
index 26605ca..c895d2a 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -1063,6 +1063,18 @@ WHOA
     _ok( !$diag, _where(), $name );
 }
 
+sub warning_is {
+    my ($code, $expect, $name) = @_;
+    my $w;
+    local $SIG {__WARN__} = sub {$w .= join "" => @_};
+    {
+       use warnings 'all';
+       &$code;
+    }
+    local $Level = $Level + 1;
+    is($w, $expect, $name);
+}
+
 # Set a watchdog to timeout the entire test file
 # NOTE:  If the test file uses 'threads', then call the watchdog() function
 #        _AFTER_ the 'threads' module is loaded.