diff options
| author | Nicholas Clark <nick@ccl4.org> | 2011-03-05 10:57:43 +0000 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2011-03-05 20:26:10 +0000 |
| commit | c11a8df30b4de6dbf6ce9fa1be2bf37869beb97d (patch) | |
| tree | 70cf9363b8d5cb3c84993f92e469a877cf171370 | |
| parent | cb124425fee7b414700604d7521979e2bfaf49c5 (diff) | |
| download | perl-c11a8df30b4de6dbf6ce9fa1be2bf37869beb97d.tar.gz | |
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.
| -rw-r--r-- | t/re/ReTest.pl | 9 | ||||
| -rw-r--r-- | t/re/pat.t | 3 | ||||
| -rw-r--r-- | t/re/pat_advanced.t | 7 | ||||
| -rw-r--r-- | t/test.pl | 12 |
4 files changed, 18 insertions, 13 deletions
diff --git a/t/re/ReTest.pl b/t/re/ReTest.pl index 41aae3a68b..fe92010c72 100644 --- 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 2640fdc0d4..c85ea81ebb 100644 --- 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 98bd08ee5c..7a06ac6e7d 100644 --- 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; @@ -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. |