+ 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 => delete $args{file},
+ args => [ '-MTest::Valgrind=run,1' ],
+ );
+ }
+
+ my $tool = delete $args{tool};
+ unless ($tool->$instanceof('Test::Valgrind::Tool')) {
+ require Test::Valgrind::Tool;
+ $tool = Test::Valgrind::Tool->new(
+ tool => $tool || 'memcheck',
+ callers => delete $args{callers},
+ );
+ }
+
+ my $action = delete $args{action};
+ unless ($action->$instanceof('Test::Valgrind::Action')) {
+ require Test::Valgrind::Action;
+ $action = Test::Valgrind::Action->new(
+ action => $action || 'Test',
+ diag => delete $args{diag},
+ );
+ }
+
+ require Test::Valgrind::Session;
+ my $sess = eval {
+ Test::Valgrind::Session->new(
+ min_version => $tool->requires_version,
+ map { $_ => delete $args{$_} } qw<extra_supps no_def_supp>
+ );
+ };
+ unless ($sess) {
+ my $err = $@;
+ $err =~ s/^(Empty valgrind candidates list|No appropriate valgrind executable could be found)\s+at.*/$1/;
+ $action->abort($sess, $err);
+ return $action->status($sess);
+ }
+
+ eval {
+ $sess->run(
+ command => $cmd,
+ tool => $tool,
+ action => $action,
+ );
+ };
+ if ($@) {
+ require Test::Valgrind::Report;
+ $action->report($sess, Test::Valgrind::Report->new_diag($@));
+ }
+
+ my $status = $sess->status;
+ $status = 255 unless defined $status;
+
+ return $status;