view release on metacpan or  search on metacpan

t/base.t  view on Meta::CPAN

			}
		],
	}, '... saving failure information' );

can_ok( $tr, 'report_failures' );
{
	my $outfh    = IO::String->new();
	my $failures = $tr->notes( 'test_failures' );
	$tr->notes( test_failures =>     [] );
	$tr->notes( test_oldfh    => $outfh );

	$tr->report_failures();
	my $text = $outfh->string_ref();
	is( $$text, "All tests passed...\n",
		'report_failures() should report success with no failures' );

	$tr->notes( test_failures => $failures );

	# this report has no actual failures, so skip it
	push @$failures,
	{
		file    => 'another_file.t', 
		ok      =>  6,
		seen    =>  6,
	};

	my ($full_report, $version, $fail_report);

	local *Module::Build::TestReporter::write_report;
	*Module::Build::TestReporter::write_report = sub 
	{
		($full_report, $version) = splice( @_, 1, 2 );
	};

	local *Module::Build::TestReporter::write_failure_results;
	*Module::Build::TestReporter::write_failure_results = sub
	{
		((my $self), $fail_report) = @_;
	};

	$tr->report_failures();

	my $fail_header  = qr/Test failures in '$fail_filename' \(1\/10\):/;
	my $fail_details = qr/fail.t.+line 9.+got: 'foo'.+expected: 'bar'/s;

	like( $full_report, $fail_header,
		'report_failures() should write a full report for all failed tests' );
	like( $full_report, $fail_details,
		'... with test failure information' );

	like( $version, qr/Summary of my perl.+Characteristics of this binary/s,
		'... and the full -V information of this perl' );

	like( $fail_report, $fail_header, '... and a failure report' );
	like( $fail_report, $fail_header, '... with failure details' );
}

can_ok( $tr, 'write_report' );
$tr->write_report( 'my report', '+version' );
ok( -e 'report.txt', 'write_report() should write its report' );
my $text = do { local (@ARGV, $/) = 'report.txt'; <> };
is( $text, 'my report+version', '... from the report passed' );

$tr->notes( report_file => '' );
throws_ok
	{ $tr->write_report( 'my report' ) }
	qr/Can't write/, 
	'... throwing an exception if it cannot write test data';

can_ok( $tr, 'write_failure_results' );
{
	local $ENV{TEST_VERBOSE} = 0;
	my $outfh                = IO::String->new();
	$tr->notes( test_oldfh => $outfh );
	my $text                 = $outfh->string_ref();

	# no contact specified
	$tr->notes( report_address => '' );
	$tr->write_failure_results( 'my report' );
	is( $$text, "Tests failed!\n",
		'write_failure_results() should only warn of failure without contact' );
	$outfh->pos( 0 );

	$tr->notes( report_file    => 'test_failures.txt'    );
	$tr->notes( report_address => 'failures@example.com' );
	$tr->write_failure_results( 'my report' );
	like( $$text, qr/e-mail 'test_failures.txt' to failures\@/,
		'... or giving e-mail directions with a contact' );
	$outfh->pos( 0 );

	$ENV{TEST_VERBOSE}       = 1;
	$tr->write_failure_results( 'my report' );
	like( $$text, qr/my report/, '... adding the report in verbose mode' );
}

END
{
	1 while unlink 'report.txt';
}