From 85300f62f158bb3fbd9dea235df81289d1e27d7d Mon Sep 17 00:00:00 2001 From: Adam Kennedy Date: Sun, 5 Apr 2009 23:42:14 +0000 Subject: [PATCH] Now I can have my fancy module without CORION's hated dependency :) Bundling Test::NoWarnings into inc --- Makefile.PL | 2 +- inc/Test/NoWarnings.pm | 310 +++++++++++++++++++++++++++++++++ inc/Test/NoWarnings/Warning.pm | 106 +++++++++++ t/12_unicode.t | 5 +- t/30_auto_rollback.t | 5 +- t/lib/Test.pm | 3 + t/rt_21406_auto_finish.t | 6 +- t/rt_29058_group_by.t | 6 +- 8 files changed, 428 insertions(+), 15 deletions(-) create mode 100644 inc/Test/NoWarnings.pm create mode 100644 inc/Test/NoWarnings/Warning.pm diff --git a/Makefile.PL b/Makefile.PL index 225a176..c1d37c8 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -214,7 +214,7 @@ WriteMakefile( LICENSE => 'perl', ), OPTIONAL( '6.11', - AUTHOR => 'Adam Kennedy ', # Maintainer + AUTHOR => 'Adam Kennedy ', # Release manager (can this be an array?) ), OPTIONAL( '6.46', META_MERGE => { diff --git a/inc/Test/NoWarnings.pm b/inc/Test/NoWarnings.pm new file mode 100644 index 0000000..f3eca9b --- /dev/null +++ b/inc/Test/NoWarnings.pm @@ -0,0 +1,310 @@ +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 produce warnings then you should be +capturing and checking them with L, that way L +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. + +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 and +C, however, if you are doing this sort of thing then you +probably want to use L in combination with L. + +=head1 USE vs REQUIRE + +You will almost always want to do + + use Test::NoWarnings + +If you do a C rather than a C, 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, + +=item o + +a full dump of the stack when warn was called, courtesy of the C +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 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-EgetMessage + +Get the message that would been printed by the warning. + +=item * + +$warn-EgetCarp + +Get a stack trace of what was going on when the warning happened, this stack +trace is just a string generated by the L module. + +=item * + +$warn-EgetTrace + +Get a stack trace object generated by the L module. This +will return undef if L is not installed. + +=item * + +$warn-EgetTest + +Get the number of the test that executed before the warning was emitted. + +=item * + +$warn-EgetTestName + +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 + +=head1 SEE ALSO + +L, L + +=head1 AUTHOR + +Written by Fergal Daly . + +=head1 COPYRIGHT + +Copyright 2003 by Fergal Daly Efergal@esatclear.ieE. + +This program is free software and comes with no warranty. It is distributed +under the LGPL license + +See the file F included in this distribution or +F. + +=cut diff --git a/inc/Test/NoWarnings/Warning.pm b/inc/Test/NoWarnings/Warning.pm new file mode 100644 index 0000000..e6e3480 --- /dev/null +++ b/inc/Test/NoWarnings/Warning.pm @@ -0,0 +1,106 @@ +use strict; + +package Test::NoWarnings::Warning; + +use Carp; + +my $has_st = eval "require Devel::StackTrace" || 0; + +sub new +{ + my $pkg = shift; + + my %args = @_; + + my $self = bless \%args, $pkg; + + return $self; +} + +sub getTrace +{ + my $self = shift; + + return $self->{Trace}; +} + +sub fillTrace +{ + my $self = shift; + $self->{Trace} = Devel::StackTrace->new( + ignore_class => [__PACKAGE__, @_], + ) if $has_st; +} + +sub getCarp +{ + my $self = shift; + + return $self->{Carp}; +} + +sub fillCarp +{ + my $self = shift; + + my $msg = shift; + + $Carp::Internal{__PACKAGE__.""}++; + local $Carp::CarpLevel = $Carp::CarpLevel + 1; + $self->{Carp} = Carp::longmess($msg); + $Carp::Internal{__PACKAGE__.""}--; +} + +sub getMessage +{ + my $self = shift; + + return $self->{Message}; +} + +sub setMessage +{ + my $self = shift; + + $self->{Message} = shift; +} + +sub fillTest +{ + my $self = shift; + + my $builder = shift; + + my $prev_test = $builder->current_test; + $self->{Test} = $prev_test; + + my @tests = $builder->details; + my $prev_test_name = $prev_test ? $tests[$prev_test - 1]->{name} : ""; + $self->{TestName} = $prev_test_name; +} + +sub getTest +{ + my $self = shift; + + return $self->{Test}; +} + +sub getTestName +{ + my $self = shift; + + return $self->{TestName}; +} + +sub toString +{ + my $self = shift; + + return <{Test} '$self->{TestName}' + $self->{Carp} +EOM +} + +1; diff --git a/t/12_unicode.t b/t/12_unicode.t index a0fc2c8..7e456d6 100644 --- a/t/12_unicode.t +++ b/t/12_unicode.t @@ -9,10 +9,9 @@ BEGIN { $^W = 1; } -my $have_nowarnings; -BEGIN { eval 'use Test::NoWarnings; $have_nowarnings = 1' }; -use Test::More tests => 15+($have_nowarnings || 0); use t::lib::Test; +use Test::More tests => 16; +use Test::NoWarnings; # # Include std stuff diff --git a/t/30_auto_rollback.t b/t/30_auto_rollback.t index 80f781e..57a5127 100644 --- a/t/30_auto_rollback.t +++ b/t/30_auto_rollback.t @@ -8,10 +8,9 @@ BEGIN { $^W = 1; } -my $have_nowarnings; -BEGIN{ eval 'use Test::NoWarnings; $have_nowarnings = 1;' }; -use Test::More tests => 5+($have_nowarnings || 0); use t::lib::Test; +use Test::More tests => 6; +use Test::NoWarnings; SCOPE: { my $dbh = connect_ok( RaiseError => 1, PrintWarn => 0 ); diff --git a/t/lib/Test.pm b/t/lib/Test.pm index 18f92d5..384bf8c 100644 --- a/t/lib/Test.pm +++ b/t/lib/Test.pm @@ -12,6 +12,9 @@ BEGIN { $VERSION = '1.19_10'; @ISA = qw{ Exporter }; @EXPORT = qw{ connect_ok }; + + # Allow tests to load modules bundled in /inc + unshift @INC, 'inc'; } # Always load the DBI module diff --git a/t/rt_21406_auto_finish.t b/t/rt_21406_auto_finish.t index b9d2ef2..b621391 100644 --- a/t/rt_21406_auto_finish.t +++ b/t/rt_21406_auto_finish.t @@ -6,11 +6,9 @@ BEGIN { $^W = 1; } -my $have_nowarnings; -BEGIN{ eval 'use Test::NoWarnings; $have_nowarnings = 1;' }; -use Test::More tests => 10+($have_nowarnings || 0); - use t::lib::Test; +use Test::More tests => 11; +use Test::NoWarnings; SCOPE: { my $dbh = connect_ok( RaiseError => 1 ); diff --git a/t/rt_29058_group_by.t b/t/rt_29058_group_by.t index f2a572e..1003a87 100644 --- a/t/rt_29058_group_by.t +++ b/t/rt_29058_group_by.t @@ -5,11 +5,9 @@ BEGIN { $^W = 1; } -my $have_nowarnings; -BEGIN{ eval 'use Test::NoWarnings; $have_nowarnings = 1;' }; -use Test::More tests => 5+($have_nowarnings || 0); - use t::lib::Test; +use Test::More tests => 6; +use Test::NoWarnings; my $dbh = connect_ok(); $dbh->do('CREATE TABLE foo (bar TEXT, num INT)');