Now I can have my fancy module without CORION's hated dependency :)

Bundling Test::NoWarnings into inc

Makefile.PL

@@ -214,7 +214,7 @@ WriteMakefile(
 		LICENSE => 'perl',	
 	),
 	OPTIONAL( '6.11',
-		AUTHOR  => 'Adam Kennedy <adamk@cpan.org>', # Maintainer
+		AUTHOR  => 'Adam Kennedy <adamk@cpan.org>', # Release manager (can this be an array?)
 	),
 	OPTIONAL( '6.46',
 		META_MERGE => {

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<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

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 <<EOM;
+	Previous test $self->{Test} '$self->{TestName}'
+	$self->{Carp}
+EOM
+}
+
+1;

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

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 );

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

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 );

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)');