- pipe my $rdr, my $wtr or croak "pipe(\$rdr, \$wtr): $!";
- my $pid = fork;
- if (!defined $pid) {
- croak "fork(): $!";
- } elsif ($pid == 0) {
- setpgrp 0, 0 or croak "setpgrp(0, 0): $!";
- close $rdr or croak "close(\$rdr): $!";
- open STDERR, '>&', $wtr or croak "open(STDERR, '>&', \$wtr): $!";
- my @args = (
- '--tool=memcheck',
- '--leak-check=full',
- '--leak-resolution=high',
- '--num-callers=' . $callers,
- '--error-limit=yes'
- );
- unless ($args{no_supp}) {
- for (Test::Valgrind::Suppressions::supp_path(), $args{supp}) {
- push @args, '--suppressions=' . $_ if $_;
- }
- }
- if (defined $args{extra} and ref $args{extra} eq 'ARRAY') {
- push @args, @{$args{extra}};
- }
- push @args, $^X;
- push @args, '-I' . $_ for @INC;
- push @args, '-MTest::Valgrind=run,1', $file;
- print STDERR "valgrind @args\n" if $args{diag};
- local $ENV{PERL_DESTRUCT_LEVEL} = 3;
- local $ENV{PERL_DL_NONLAZY} = 1;
- exec $vg, @args;
+ }
+ unless (defined($file) or defined($file = $pm)) {
+ require Test::Builder;
+ Test::Builder->new->diag('Couldn\'t find a valid source file');
+ return;
+ }
+
+ my $taint_mode;
+ {
+ open my $fh, '<', $file or last;
+ my $first = <$fh>;
+ close $fh;
+ if ($first and my ($args) = $first =~ /^\s*#\s*!\s*perl\s*(.*)/) {
+ $taint_mode = 1 if $args =~ /(?:^|\s)-T(?:$|\s)/;