/usr/local/share/perl5/Test
Edit: /usr/local/share/perl5/Test/Warnings.pm (14636B)
use strict;
use warnings;
package Test::Warnings; # git description: v0.029-2-g97d1c9f
# vim: set ts=8 sts=4 sw=4 tw=115 et :
# ABSTRACT: Test for warnings and the lack of them
# KEYWORDS: testing tests warnings
our $VERSION = '0.030';
use parent 'Exporter';
use Test::Builder;
our @EXPORT_OK = qw(
allow_warnings allowing_warnings
had_no_warnings
warnings warning
);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );
my $warnings_allowed;
my $forbidden_warnings_found;
my $done_testing_called;
my $no_end_test;
my $fail_on_warning;
my $report_warnings;
my @collected_warnings;
sub import
{
my $class = shift @_;
my %names; @names{@_} = ();
# END block will check for this status
$no_end_test = exists $names{':no_end_test'};
# __WARN__ handler will check for this status
$fail_on_warning = exists $names{':fail_on_warning'};
# Collect and report warnings at the end
$report_warnings = exists $names{':report_warnings'};
delete @names{qw(:no_end_test :fail_on_warning :report_warnings)};
__PACKAGE__->export_to_level(1, $class, keys %names);
}
# for testing this module only!
my $tb;
sub _builder(;$)
{
if (not @_)
{
$tb ||= Test::Builder->new;
return $tb;
}
$tb = shift;
}
my $_orig_warn_handler = $SIG{__WARN__};
$SIG{__WARN__} = sub {
if ($warnings_allowed)
{
Test::Builder->new->note($_[0]);
}
else
{
$forbidden_warnings_found++;
push @collected_warnings, $_[0] if $report_warnings;
# TODO: this doesn't handle blessed coderefs... does anyone care?
goto &$_orig_warn_handler if $_orig_warn_handler
and ( (ref $_orig_warn_handler eq 'CODE')
or ($_orig_warn_handler ne 'DEFAULT'
and $_orig_warn_handler ne 'IGNORE'
and defined &$_orig_warn_handler));
if ($_[0] =~ /\n$/) {
warn $_[0];
} else {
require Carp;
Carp::carp($_[0]);
}
_builder->ok(0, 'unexpected warning') if $fail_on_warning;
}
};
sub warnings(;&)
{
# if someone manually does warnings->import in the same namespace this is
# imported into, this sub will be called. in that case, just return the
# string "warnings" so it calls the correct method.
if (!@_) {
return 'warnings';
}
my $code = shift;
my @warnings;
local $SIG{__WARN__} = sub {
push @warnings, shift;
};
$code->();
@warnings;
}
sub warning(&)
{
my @warnings = &warnings(@_);
return @warnings == 1 ? $warnings[0] : \@warnings;
}
if (Test::Builder->can('done_testing'))
{
# monkeypatch Test::Builder::done_testing:
# check for any forbidden warnings, and record that we have done so
# so we do not check again via END
no strict 'refs';
my $orig = *{'Test::Builder::done_testing'}{CODE};
no warnings 'redefine';
*{'Test::Builder::done_testing'} = sub {
# only do this at the end of all tests, not at the end of a subtest
my $builder = _builder;
my $in_subtest_sub = $builder->can('in_subtest');
if (not $no_end_test
and not ($in_subtest_sub ? $builder->$in_subtest_sub : $builder->parent))
{
local $Test::Builder::Level = $Test::Builder::Level + 3;
had_no_warnings('no (unexpected) warnings (via done_testing)');
$done_testing_called = 1;
}
$orig->(@_);
};
}
END {
if (not $no_end_test
and not $done_testing_called
# skip this if there is no plan and no tests have been run (e.g.
# compilation tests of this module!)
and (_builder->expected_tests or _builder->current_test > 0)
)
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
had_no_warnings('no (unexpected) warnings (via END block)');
}
}
# setter
sub allow_warnings(;$)
{
$warnings_allowed = @_ || defined $_[0] ? $_[0] : 1;
}
# getter
sub allowing_warnings() { $warnings_allowed }
# call at any time to assert no (unexpected) warnings so far
sub had_no_warnings(;$)
{
_builder->ok(!$forbidden_warnings_found, shift || 'no (unexpected) warnings');
if ($report_warnings and $forbidden_warnings_found) {
_builder->diag("Got the following unexpected warnings:");
for my $i (1 .. @collected_warnings) {
_builder->diag(" $i: $collected_warnings[ $i - 1 ]");
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Warnings - Test for warnings and the lack of them
=head1 VERSION
version 0.030
=head1 SYNOPSIS
use Test::More;
use Test::Warnings;
pass('yay!');
done_testing;
emits TAP:
ok 1 - yay!
ok 2 - no (unexpected) warnings (via done_testing)
1..2
and:
use Test::More tests => 3;
use Test::Warnings 0.005 ':all';
pass('yay!');
like(warning { warn "oh noes!" }, qr/^oh noes/, 'we warned');
emits TAP:
ok 1 - yay!
ok 2 - we warned
ok 3 - no (unexpected) warnings (via END block)
1..3
=head1 DESCRIPTION
If you've ever tried to use L
to confirm there are no warnings
generated by your tests, combined with the convenience of C to
not have to declare a
L,
you'll have discovered that these two features do not play well together,
as the test count will be calculated I the warnings test is run,
resulting in a TAP error. (See C in this
distribution for a demonstration.)
This module is intended to be used as a drop-in replacement for
L: it also adds an extra test, but runs this test I
C calculates the test count, rather than after. It does this by
hooking into C as well as via an C block. You can declare
a plan, or not, and things will still Just Work.
It is actually equivalent to:
use Test::NoWarnings 1.04 ':early';
as warnings are still printed normally as they occur. You are safe, and
enthusiastically encouraged, to perform a global search-replace of the above
with C