1 package Test::Valgrind::Action::Test;
8 Test::Valgrind::Action::Test - Test that an analysis didn't generate any error report.
16 our $VERSION = '1.00';
20 This action uses C<Test::Builder> to plan and pass or fail tests according to the reports received.
26 use base qw/Test::Valgrind::Action Test::Valgrind::Action::Captor/;
30 This class inherits L<Test::Valgrind::Action> and L<Test::Valgrind::Action::Captor>.
32 =head2 C<< new diag => $diag, extra_tests => $extra_tests, ... >>
34 Your usual constructor.
36 When C<$diag> is true, the original output of the command and the error reports are intermixed as diagnostics.
38 C<$extra_tests> specifies how many extraneous tests you want to plan in addition to the default ones.
40 Other arguments are passed straight to C<< Test::Valgrind::Action->new >>.
46 $class = ref($class) || $class;
50 my $diag = delete $args{diag};
51 my $extra_tests = delete $args{extra_tests} || 0;
53 my $self = bless $class->SUPER::new(%args), $class;
55 $self->{diag} = $diag;
56 $self->{extra_tests} = $extra_tests;
63 Read-only accessor for the C<diag> option.
67 sub diag { $_[0]->{diag} }
71 Returns the list of all the monitored report kinds.
75 sub kinds { @{$_[0]->{kinds} || []} }
78 my ($self, $sess) = @_;
80 $self->SUPER::start($sess);
82 my @kinds = grep $_ ne 'Diag', $sess->report_class->kinds;
83 $self->{kinds} = \@kinds;
86 my $tb = Test::Builder->new;
88 $tb->plan(tests => $self->{extra_tests} + scalar @kinds);
90 $self->restore_all_fh;
92 delete $self->{capture};
95 $self->{capture} = File::Temp::tempfile();
96 $self->{capture_pos} = 0;
99 $self->save_fh(\*STDOUT => '>' => $self->{capture});
100 $self->save_fh(\*STDERR => '>' => $self->{capture});
106 my ($self, $sess, $msg) = @_;
108 $self->restore_all_fh;
110 my $tb = Test::Builder->new;
111 my $plan = $tb->has_plan;
114 $self->{status} = 255;
124 my ($self, $sess, $report) = @_;
126 if ($report->is_diag) {
127 my $tb = Test::Builder->new;
128 $tb->diag($report->data);
132 $self->SUPER::report($sess, $report);
134 $self->{reports}->{$report->kind}->{$report->id} = $report;
137 my $tb = Test::Builder->new;
138 my $fh = $self->{capture};
139 seek $fh, $self->{capture_pos}, 0;
140 $tb->diag($_) while <$fh>;
141 $self->{capture_pos} = tell $fh;
142 $tb->diag($report->dump);
149 my ($self, $sess) = @_;
151 $self->SUPER::finish($sess);
153 my $tb = Test::Builder->new;
155 $self->restore_all_fh;
157 if (my $fh = $self->{capture}) {
158 seek $fh, $self->{capture_pos}, 0;
159 $tb->diag($_) while <$fh>;
160 close $fh or $self->_croak('close(capture[' . fileno($fh) . "]): $!");
161 delete @{$self}{qw/capture capture_pos/};
166 for my $kind ($self->kinds) {
167 my $reports = $self->{reports}->{$kind} || { };
168 my $errors = keys %$reports;
169 $tb->is_num($errors, 0, $kind);
172 unless ($self->diag) {
173 $tb->diag("\n" . $_->dump) for values %$reports;
178 $self->{status} = $failed < 255 ? $failed : 254;
184 my ($self, $sess) = @_;
186 $self->SUPER::status($sess);
193 L<Test::Valgrind>, L<Test::Valgrind::Action>.
197 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
199 You can contact me by mail or on C<irc.perl.org> (vincent).
203 Please report any bugs or feature requests to C<bug-test-valgrind at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>.
204 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
208 You can find documentation for this module with the perldoc command.
210 perldoc Test::Valgrind::Action::Test
212 =head1 COPYRIGHT & LICENSE
214 Copyright 2009 Vincent Pit, all rights reserved.
216 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
220 1; # End of Test::Valgrind::Action::Test