From: Vincent Pit Date: Thu, 12 Nov 2015 15:11:38 +0000 (-0200) Subject: Improve error handling before exec X-Git-Tag: v1.16~4 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=1f7e2b57ff41bebac83b89c3e1cbadecd872c1ae;p=perl%2Fmodules%2FTest-Valgrind.git Improve error handling before exec IO::Select is required. --- diff --git a/MANIFEST b/MANIFEST index 0573979..d1c5366 100644 --- a/MANIFEST +++ b/MANIFEST @@ -37,6 +37,7 @@ t/12-good-run-exception.t t/20-bad.t t/30-skip.t t/70-session.t +t/71-session-command.t t/80-suppressions.t t/81-suppressions-demangle.t t/lib/Test/Valgrind/FakeValgrind.pm diff --git a/Makefile.PL b/Makefile.PL index f6fb3be..202071d 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -130,6 +130,7 @@ my %PREREQ_PM = ( 'File::Temp' => '0.14', # OO interface 'Filter::Util::Call' => 0, 'Fcntl' => 0, + 'IO::Select' => 0, 'List::Util' => 0, 'POSIX' => 0, 'Perl::Destruct::Level' => 0, diff --git a/lib/Test/Valgrind/Session.pm b/lib/Test/Valgrind/Session.pm index b0069df..99f8314 100644 --- a/lib/Test/Valgrind/Session.pm +++ b/lib/Test/Valgrind/Session.pm @@ -25,8 +25,9 @@ It also acts as a dispatcher between the different components. use File::Spec (); use Scalar::Util (); -use Fcntl (); # F_SETFD -use POSIX (); # SIGKILL +use Fcntl (); # F_SETFD +use IO::Select; +use POSIX (); # SIGKILL, _exit() use version (); @@ -302,56 +303,121 @@ sub run { @supp_args = map "--suppressions=$_", @supp_files; } - my $guard = Test::Valgrind::Session::Guard->new(sub { $self->finish }); - $self->start; + my $error; + GUARDED: { + my $guard = Test::Valgrind::Session::Guard->new(sub { $self->finish }); + $self->start; - pipe my $vrdr, my $vwtr or $self->_croak("pipe(\$vrdr, \$vwtr): $!"); - { - my $oldfh = select $vrdr; - $|++; - select $oldfh; - } - - my $pid = fork; - $self->_croak("fork(): $!") unless defined $pid; + pipe my $vrdr, my $vwtr or $self->_croak("pipe(\$vrdr, \$vwtr): $!"); + { + my $oldfh = select $vrdr; + $|++; + select $oldfh; + } - if ($pid == 0) { + pipe my $erdr, my $ewtr or $self->_croak("pipe(\$erdr, \$ewtr): $!"); { - local $@; - eval { setpgrp(0, 0) }; + my $oldfh = select $erdr; + $|++; + select $oldfh; } - close $vrdr or $self->_croak("close(\$vrdr): $!"); - fcntl $vwtr, Fcntl::F_SETFD(), 0 + + my $pid = fork; + $self->_croak("fork(): $!") unless defined $pid; + + if ($pid == 0) { + { + local $@; + eval { setpgrp(0, 0) }; + } + + close $erdr or POSIX::_exit(255); + + local $@; + eval { + close $vrdr or $self->_croak("close(\$vrdr): $!"); + + fcntl $vwtr, Fcntl::F_SETFD(), 0 or $self->_croak("fcntl(\$vwtr, F_SETFD, 0): $!"); - my @args = ( - $self->valgrind, - $self->tool->args($self), - @supp_args, - $self->parser->args($self, $vwtr), - $self->command->args($self), - ); + my @args = ( + $self->valgrind, + $self->tool->args($self), + @supp_args, + $self->parser->args($self, $vwtr), + $self->command->args($self), + ); -# $self->report($self->report_class->new_diag("@args")); + { + no warnings 'exec'; + exec { $args[0] } @args; + } + $self->_croak("exec @args: $!"); + }; - exec { $args[0] } @args or $self->_croak("exec @args: $!"); - } + print $ewtr $@; + close $ewtr; + + POSIX::_exit(255); + } + + local $@; + eval { + local $SIG{INT} = sub { + die 'valgrind analysis was interrupted'; + }; + + close $vwtr or $self->_croak("close(\$vwtr): $!"); + close $ewtr or $self->_croak("close(\$ewtr): $!"); + + SEL: { + my $sel = IO::Select->new($vrdr, $erdr); + + my $child_err; + while (my @ready = $sel->can_read) { + last SEL if @ready == 1 and fileno $ready[0] == fileno $vrdr; + + my $buf; + my $bytes_read = sysread $erdr, $buf, 4096; + if (not defined $bytes_read) { + $self->_croak("sysread(\$erdr): $!"); + } elsif ($bytes_read) { + $sel->remove($vrdr) unless $child_err; + $child_err .= $buf; + } else { + $sel->remove($erdr); + die $child_err if $child_err; + } + } + } + + my $aborted = $self->parser->parse($self, $vrdr); - local $SIG{INT} = sub { - kill -(POSIX::SIGKILL()) => $pid; - waitpid $pid, 0; - die 'valgrind analysis was interrupted'; - }; + if ($aborted) { + $self->report($self->report_class->new_diag("valgrind has aborted")); + return 0; + } - close $vwtr or $self->_croak("close(\$vwtr): $!"); + 1; + } or do { + $error = $@; + kill -(POSIX::SIGKILL()) => $pid if kill 0 => $pid; + close $erdr; + close $vrdr; + waitpid $pid, 0; + # Force the guard destructor to trigger now so that old perls don't lose $@ + last GUARDED; + }; - my $aborted = $self->parser->parse($self, $vrdr); + $self->{exit_code} = (waitpid($pid, 0) == $pid) ? $? >> 8 : 255; - kill -(POSIX::SIGKILL()) => $pid if $aborted; + close $erdr or $self->_croak("close(\$erdr): $!"); + close $vrdr or $self->_croak("close(\$vrdr): $!"); - $self->{exit_code} = (waitpid($pid, 0) == $pid) ? $? >> 8 : 255; + return; + } - close $vrdr or $self->_croak("close(\$vrdr): $!"); + die $error if $error; return; } diff --git a/t/71-session-command.t b/t/71-session-command.t new file mode 100644 index 0000000..54ce89d --- /dev/null +++ b/t/71-session-command.t @@ -0,0 +1,95 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 2; + +use Test::Valgrind::Command; +use Test::Valgrind::Tool; +use Test::Valgrind::Session; + +use lib 't/lib'; +use Test::Valgrind::FakeValgrind; + +my $cmd = Test::Valgrind::Command->new( + command => 'Perl', + args => [ '-e1' ], +); + +{ + package Test::Valgrind::Parser::Dummy; + + use base 'Test::Valgrind::Parser'; + + sub parse { } +} + +{ + package Test::Valgrind::Tool::Dummy; + + use base 'Test::Valgrind::Tool::memcheck'; + + sub parser_class { 'Test::Valgrind::Parser::Dummy' } +} + +my $tool = Test::Valgrind::Tool::Dummy->new(); + +{ + package Test::Valgrind::Action::Dummy; + + use base 'Test::Valgrind::Action'; + + sub do_suppressions { 0 } + + sub report { + my ($self, $sess, $report) = @_; + + if ($report->is_diag) { + my $contents = $report->data; + if ($contents !~ /^(?:Using valgrind |No suppressions used)/) { + ::diag($contents); + } + return; + } else { + $self->SUPER::report($sess, $report); + } + } +} + +my $action = Test::Valgrind::Action::Dummy->new(); + +SKIP: { + my $tmp_vg; + my $sess; + + { + my $dummy_vg = Test::Valgrind::FakeValgrind->new( + exe_name => 'invisible_pink_unicorn' + ); + skip $dummy_vg => 2 unless ref $dummy_vg; + $tmp_vg = $dummy_vg->path; + + local $@; + $sess = eval { + Test::Valgrind::Session->new( + allow_no_supp => 1, + no_def_supp => 1, + valgrind => $tmp_vg, + ); + }; + is $@, '', 'session was correctly created'; + } + + skip 'dummy valgrind executable was not deleted' => 1 if -e $tmp_vg; + + local $@; + eval { + $sess->run( + action => $action, + command => $cmd, + tool => $tool, + ); + }; + like $@, qr/invisible_pink_unicorn/, 'command not found croaks'; +}