t/71-session-command.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 2;
   7
   8 use Test::Valgrind::Command;
   9 use Test::Valgrind::Tool;
  10 use Test::Valgrind::Session;
  11
  12 use lib 't/lib';
  13 use Test::Valgrind::FakeValgrind;
  14
  15 my $cmd = Test::Valgrind::Command->new(
  16  command => 'Perl',
  17  args    => [ '-e1' ],
  18 );
  19
  20 {
  21  package Test::Valgrind::Parser::Dummy;
  22
  23  use base 'Test::Valgrind::Parser';
  24
  25  sub parse { }
  26 }
  27
  28 {
  29  package Test::Valgrind::Tool::Dummy;
  30
  31  use base 'Test::Valgrind::Tool::memcheck';
  32
  33  sub parser_class { 'Test::Valgrind::Parser::Dummy' }
  34 }
  35
  36 my $tool = Test::Valgrind::Tool::Dummy->new();
  37
  38 {
  39  package Test::Valgrind::Action::Dummy;
  40
  41  use base 'Test::Valgrind::Action';
  42
  43  sub do_suppressions { 0 }
  44
  45  sub report {
  46   my ($self, $sess, $report) = @_;
  47
  48   if ($report->is_diag) {
  49    my $contents = $report->data;
  50    if ($contents !~ /^(?:Using valgrind |No suppressions used)/) {
  51     ::diag($contents);
  52    }
  53    return;
  54   } else {
  55    $self->SUPER::report($sess, $report);
  56   }
  57  }
  58 }
  59
  60 my $action = Test::Valgrind::Action::Dummy->new();
  61
  62 SKIP: {
  63  my $tmp_vg;
  64  my $sess;
  65
  66  {
  67   my $dummy_vg = Test::Valgrind::FakeValgrind->new(
  68    exe_name => 'invisible_pink_unicorn'
  69   );
  70   skip $dummy_vg => 2 unless ref $dummy_vg;
  71   $tmp_vg = $dummy_vg->path;
  72
  73   local $@;
  74   $sess = eval {
  75    Test::Valgrind::Session->new(
  76     allow_no_supp => 1,
  77     no_def_supp   => 1,
  78     valgrind      => $tmp_vg,
  79    );
  80   };
  81   is $@, '', 'session was correctly created';
  82  }
  83
  84  skip 'dummy valgrind executable was not deleted' => 1 if -e $tmp_vg;
  85
  86  local $@;
  87  eval {
  88   $sess->run(
  89    action  => $action,
  90    command => $cmd,
  91    tool    => $tool,
  92   );
  93  };
  94  like $@, qr/invisible_pink_unicorn/, 'command not found croaks';
  95 }