1b8851fccSafresh1# $Header: /home/fergal/my/cvs/Test-Tester/lib/Test/Tester/CaptureRunner.pm,v 1.3 2003/03/05 01:07:55 fergal Exp $ 2b8851fccSafresh1use strict; 3b8851fccSafresh1 4b8851fccSafresh1package Test::Tester::CaptureRunner; 5b8851fccSafresh1 6*3d61058aSafresh1our $VERSION = '1.302199'; 75759b3d2Safresh1 85759b3d2Safresh1 9b8851fccSafresh1use Test::Tester::Capture; 10b8851fccSafresh1require Exporter; 11b8851fccSafresh1 12b8851fccSafresh1sub new 13b8851fccSafresh1{ 14b8851fccSafresh1 my $pkg = shift; 15b8851fccSafresh1 my $self = bless {}, $pkg; 16b8851fccSafresh1 return $self; 17b8851fccSafresh1} 18b8851fccSafresh1 19b8851fccSafresh1sub run_tests 20b8851fccSafresh1{ 21b8851fccSafresh1 my $self = shift; 22b8851fccSafresh1 23b8851fccSafresh1 my $test = shift; 24b8851fccSafresh1 25b8851fccSafresh1 capture()->reset; 26b8851fccSafresh1 27b8851fccSafresh1 $self->{StartLevel} = $Test::Builder::Level; 28b8851fccSafresh1 &$test(); 29b8851fccSafresh1} 30b8851fccSafresh1 31b8851fccSafresh1sub get_results 32b8851fccSafresh1{ 33b8851fccSafresh1 my $self = shift; 34b8851fccSafresh1 my @results = capture()->details; 35b8851fccSafresh1 36b8851fccSafresh1 my $start = $self->{StartLevel}; 37b8851fccSafresh1 foreach my $res (@results) 38b8851fccSafresh1 { 39b8851fccSafresh1 next if defined $res->{depth}; 40b8851fccSafresh1 my $depth = $res->{_depth} - $res->{_level} - $start - 3; 41b8851fccSafresh1# print "my $depth = $res->{_depth} - $res->{_level} - $start - 1\n"; 42b8851fccSafresh1 $res->{depth} = $depth; 43b8851fccSafresh1 } 44b8851fccSafresh1 45b8851fccSafresh1 return @results; 46b8851fccSafresh1} 47b8851fccSafresh1 48b8851fccSafresh1sub get_premature 49b8851fccSafresh1{ 50b8851fccSafresh1 return capture()->premature; 51b8851fccSafresh1} 52b8851fccSafresh1 53b8851fccSafresh1sub capture 54b8851fccSafresh1{ 55b8851fccSafresh1 return Test::Tester::Capture->new; 56b8851fccSafresh1} 57b8851fccSafresh1 58b8851fccSafresh1__END__ 59b8851fccSafresh1 60b8851fccSafresh1=head1 NAME 61b8851fccSafresh1 62b8851fccSafresh1Test::Tester::CaptureRunner - Help testing test modules built with Test::Builder 63b8851fccSafresh1 64b8851fccSafresh1=head1 DESCRIPTION 65b8851fccSafresh1 66b8851fccSafresh1This stuff if needed to allow me to play with other ways of monitoring the 67b8851fccSafresh1test results. 68b8851fccSafresh1 69b8851fccSafresh1=head1 AUTHOR 70b8851fccSafresh1 71b8851fccSafresh1Copyright 2003 by Fergal Daly <fergal@esatclear.ie>. 72b8851fccSafresh1 73b8851fccSafresh1=head1 LICENSE 74b8851fccSafresh1 75b8851fccSafresh1Under the same license as Perl itself 76b8851fccSafresh1 77*3d61058aSafresh1See L<https://dev.perl.org/licenses/> 78b8851fccSafresh1 79b8851fccSafresh1=cut 80