]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blobdiff - t/lib/Test/Valgrind/FakeValgrind.pm
Factor the fake valgrind test helper into a separate class
[perl/modules/Test-Valgrind.git] / t / lib / Test / Valgrind / FakeValgrind.pm
diff --git a/t/lib/Test/Valgrind/FakeValgrind.pm b/t/lib/Test/Valgrind/FakeValgrind.pm
new file mode 100644 (file)
index 0000000..098bae0
--- /dev/null
@@ -0,0 +1,67 @@
+package Test::Valgrind::FakeValgrind;
+
+use strict;
+use warnings;
+
+use Config ();
+use File::Spec;
+use File::Temp;
+
+sub _dummy_valgrind_code {
+ my ($version) = @_;
+
+ my $perl = $^X;
+ unless (-e $perl and -x $perl) {
+  $perl = $Config::Config{perlpath};
+  unless (-e $perl and -x $perl) {
+   return undef;
+  }
+ }
+
+ return <<" FAKE_VG";
+#!$perl
+if (\@ARGV == 1 && \$ARGV[0] eq '--version') {
+ print "valgrind-$version\n";
+}
+ FAKE_VG
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ my $exe_name = $args{exe_name};
+ my $version  = $args{version} || '3.1.0';
+
+ my $self = { };
+
+ if (defined $exe_name) {
+  $self->{tmp_dir_obj}  = File::Temp->newdir(CLEANUP => 1);
+  $self->{tmp_dir}      = $self->{tmp_dir_obj}->dirname;
+  $self->{tmp_file}     = File::Spec->catfile($self->{tmp_dir}, $exe_name);
+ } else {
+  $self->{tmp_file_obj} = File::Temp->new(UNLINK => 1);
+  $self->{tmp_file}     = $self->{tmp_file_obj}->filename;
+  my ($vol, $dir)       = File::Spec->splitpath($self->{tmp_file});
+  $self->{tmp_dir}      = File::Spec->catpath($vol, $dir, '');
+ }
+
+ my $code = _dummy_valgrind_code($version);
+ return 'Could not generate the dummy valgrind executable' unless $code;
+
+ return 'Temporary file already exists' if -s $self->{tmp_file};
+
+ {
+  open my $vg_fh, '>', $self->{tmp_file};
+  print $vg_fh $code;
+  close $vg_fh;
+  chmod 0755, $self->{tmp_file};
+ }
+
+ bless $self, $class;
+}
+
+sub path { $_[0]->{tmp_file} }
+
+sub dir  { $_[0]->{tmp_dir} }
+
+1;