t/lib/Test/Valgrind/FakeValgrind.pm

   1 package Test::Valgrind::FakeValgrind;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config ();
   7 use File::Spec;
   8 use File::Temp;
   9
  10 sub _dummy_valgrind_code {
  11  my ($version) = @_;
  12
  13  my $perl = $^X;
  14  unless (-e $perl and -x $perl) {
  15   $perl = $Config::Config{perlpath};
  16   unless (-e $perl and -x $perl) {
  17    return undef;
  18   }
  19  }
  20
  21  return <<" FAKE_VG";
  22 #!$perl
  23 if (\@ARGV == 1 && \$ARGV[0] eq '--version') {
  24  print "valgrind-$version\n";
  25 }
  26  FAKE_VG
  27 }
  28
  29 sub new {
  30  my ($class, %args) = @_;
  31
  32  my $exe_name = $args{exe_name};
  33  my $version  = $args{version} || '3.1.0';
  34
  35  my $self = { };
  36
  37  if (defined $exe_name) {
  38   $self->{tmp_dir_obj}  = File::Temp->newdir(CLEANUP => 1);
  39   $self->{tmp_dir}      = $self->{tmp_dir_obj}->dirname;
  40   $self->{tmp_file}     = File::Spec->catfile($self->{tmp_dir}, $exe_name);
  41  } else {
  42   $self->{tmp_file_obj} = File::Temp->new(UNLINK => 1);
  43   $self->{tmp_file}     = $self->{tmp_file_obj}->filename;
  44   my ($vol, $dir)       = File::Spec->splitpath($self->{tmp_file});
  45   $self->{tmp_dir}      = File::Spec->catpath($vol, $dir, '');
  46  }
  47
  48  my $code = _dummy_valgrind_code($version);
  49  return 'Could not generate the dummy valgrind executable' unless $code;
  50
  51  return 'Temporary file already exists' if -s $self->{tmp_file};
  52
  53  {
  54   open my $vg_fh, '>', $self->{tmp_file};
  55   print $vg_fh $code;
  56   close $vg_fh;
  57   chmod 0755, $self->{tmp_file};
  58  }
  59
  60  bless $self, $class;
  61 }
  62
  63 sub path { $_[0]->{tmp_file} }
  64
  65 sub dir  { $_[0]->{tmp_dir} }
  66
  67 1;