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