use strict;
use warnings;
package Test::NoWarnings;
use Test::Builder;
use Test::NoWarnings::Warning;
my $Test = Test::Builder->new;
my $PID = $$;
use Carp;
use vars qw(
$VERSION @EXPORT_OK @ISA $do_end_test
);
$VERSION = '0.084';
require Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw(
clear_warnings had_no_warnings warnings
);
my @warnings;
$SIG{__WARN__} = make_catcher(\@warnings);
$do_end_test = 0;
sub import
{
$do_end_test = 1;
goto &Exporter::import;
}
# the END block must be after the "use Test::Builder" to make sure it runs
# before Test::Builder's end block
# only run the test if there have been other tests
END {
had_no_warnings() if $do_end_test;
}
sub make_warning
{
local $SIG{__WARN__};
my $msg = shift;
my $warning = Test::NoWarnings::Warning->new;
$warning->setMessage($msg);
$warning->fillTest($Test);
$warning->fillTrace(__PACKAGE__);
$Carp::Internal{__PACKAGE__.""}++;
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
$warning->fillCarp($msg);
$Carp::Internal{__PACKAGE__.""}--;
return $warning;
}
sub make_catcher
{
# this make a subroutine which can be used in $SIG{__WARN__}
# it takes one argument, a ref to an array
# it will push the details of the warning onto the end of the array.
my $array = shift;
return sub {
my $msg = shift;
$Carp::Internal{__PACKAGE__.""}++;
push(@$array, make_warning($msg));
$Carp::Internal{__PACKAGE__.""}--;
return $msg;
};
}
sub had_no_warnings
{
return 0 if $$ != $PID;
local $SIG{__WARN__};
my $name = shift || "no warnings";
my $ok;
my $diag;
if (@warnings == 0)
{
$ok = 1;
}
else
{
$ok = 0;
$diag = "There were ".@warnings." warning(s)\n";
$diag .= join("----------\n", map { $_->toString } @warnings);
}
$Test->ok($ok, $name) || $Test->diag($diag);
return $ok;
}
sub clear_warnings
{
local $SIG{__WARN__};
@warnings = ();
}
sub warnings
{
local $SIG{__WARN__};
return @warnings;
}
sub builder
{
local $SIG{__WARN__};
if (@_)
{
$Test = shift;
}
return $Test;
}
1;
__END__
=head1 NAME
Test::NoWarnings - Make sure you didn't emit any warnings while testing
=head1 SYNOPSIS
For scripts that have no plan
use Test::NoWarnings;
that's it, you don't need to do anything else
For scripts that look like
use Test::More tests => x;
change to
use Test::More tests => x + 1;
use Test::NoWarnings;
=head1 DESCRIPTION
In general, your tests shouldn't produce warnings. This modules causes any
warnings to be captured and stored. It automatically adds an extra test that
will run when your script ends to check that there were no warnings. If
there were any warings, the test will give a "not ok" and diagnostics of
where, when and what the warning was, including a stack trace of what was
going on when the it occurred.
If some of your tests B<are supposed to> produce warnings then you should be
capturing and checking them with L<Test::Warn>, that way L<Test::NoWarnings>
will not see them and so not complain.
The test is run by an END block in Test::NoWarnings. It will not be run when
any forked children exit.
=head1 USAGE
Simply by using the module, you automatically get an extra test at the end
of your script that checks that no warnings were emitted. So just stick
use Test::NoWarnings
at the top of your script and continue as normal.
If you want more control you can invoke the test manually at any time with
C<had_no_warnings()>.
The warnings your test has generated so far are stored in an array. You can
look inside and clear this whenever you want with C<warnings()> and
C<clear_warnings()>, however, if you are doing this sort of thing then you
probably want to use L<Test::Warn> in combination with L<Test::NoWarnings>.
=head1 USE vs REQUIRE
You will almost always want to do
use Test::NoWarnings
If you do a C<require> rather than a C<use>, then there will be no automatic
test at the end of your script.
=head1 OUTPUT
If warning is captured during your test then the details will output as part
of the diagnostics. You will get:
=over 2
=item o
the number and name of the test that was executed just before the warning
(if no test had been executed these will be 0 and '')
=item o
the message passed to C<warn>,
=item o
a full dump of the stack when warn was called, courtesy of the C<Carp>
module
=back
=head1 EXPORTABLE FUNCTIONS
=head2 had_no_warnings()
This checks that there have been warnings emitted by your test scripts.
Usually you will not call this explicitly as it is called automatically when
your script finishes.
=head2 clear_warnings()
This will clear the array of warnings that have been captured. If the array
is empty then a call to C<had_no_warnings()> will produce a pass result.
=head2 warnings()
This will return the array of warnings captured so far. Each element of this
array is an object containing information about the warning. The following
methods are available on these object.
=over 2
=item *
$warn-E<gt>getMessage
Get the message that would been printed by the warning.
=item *
$warn-E<gt>getCarp
Get a stack trace of what was going on when the warning happened, this stack
trace is just a string generated by the L<Carp> module.
=item *
$warn-E<gt>getTrace
Get a stack trace object generated by the L<Devel::StackTrace> module. This
will return undef if L<Devel::StackTrace> is not installed.
=item *
$warn-E<gt>getTest
Get the number of the test that executed before the warning was emitted.
=item *
$warn-E<gt>getTestName
Get the name of the test that executed before the warning was emitted.
=back
=head1 PITFALLS
When counting your tests for the plan, don't forget to include the test that
runs automatically when your script ends.
=head1 BUGS
None that I know of.
=head1 HISTORY
This was previously known as L<Test::Warn::None>
=head1 SEE ALSO
L<Test::Builder>, L<Test::Warn>
=head1 AUTHOR
Written by Fergal Daly <fergal@esatclear.ie>.
=head1 COPYRIGHT
Copyright 2003 by Fergal Daly E<lt>fergal@esatclear.ieE<gt>.
This program is free software and comes with no warranty. It is distributed
under the LGPL license
See the file F<LGPL> included in this distribution or
F<http://www.fsf.org/licenses/licenses.html>.
=cut