Allow passing a command to Test::Valgrind->import

[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind.pm

diff --git a/lib/Test/Valgrind.pm b/lib/Test/Valgrind.pm
index 1fac2874569b08006eb3e78ada7efd2a794d8cef..4b33486fe3e34b5eeae8e74d0f2aa01b68dbbccb 100644 (file)
--- a/lib/Test/Valgrind.pm
+++ b/lib/Test/Valgrind.pm
@@ -47,6 +47,14 @@ You can pass parameters to C<import> as a list of key / value pairs, where valid
 
 =item *
 
+C<< command => $command >>
+
+The L<Test::Valgrind::Command> object (or class name) to use.
+
+Defaults to L<Test::Valgrind::Command::PerlScript>.
+
+=item *
+
 C<< tool => $tool >>
 
 The L<Test::Valgrind::Tool> object (or class name) to use.
@@ -136,27 +144,21 @@ sub import {
   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)/;
-  }
- }
-
- require Test::Valgrind::Command;
- my $cmd = Test::Valgrind::Command->new(
-  command => 'Perl',
-  args    => [ '-MTest::Valgrind=run,1', (('-T') x!! $taint_mode), $file ],
- );
-
  my $instanceof = sub {
   require Scalar::Util;
   Scalar::Util::blessed($_[0]) && $_[0]->isa($_[1]);
  };
 
+ my $cmd = delete $args{command};
+ unless ($cmd->$instanceof('Test::Valgrind::Command')) {
+  require Test::Valgrind::Command;
+  $cmd = Test::Valgrind::Command->new(
+   command => $cmd || 'PerlScript',
+   file    => $file,
+   args    => [ '-MTest::Valgrind=run,1' ],
+  );
+ }
+
  my $tool = delete $args{tool};
  unless ($tool->$instanceof('Test::Valgrind::Tool')) {
   require Test::Valgrind::Tool;