+Defaults to false.
+
+=item *
+
+C<< allow_no_supp => $bool >>
+
+If true, force running the analysis even if the suppression files do not refer to any C<perl>-related symbol.
+
+Defaults to false.
+
+=item *
+
+C<< extra_supps => \@files >>
+
+Also use suppressions from C<@files> besides C<perl>'s.
+
+Defaults to empty.
+
+=back
+
+=cut
+
+sub _croak {
+ require Carp;
+ Carp::croak(@_);
+}
+
+my %skippable_errors = (
+ session => [
+ 'Empty valgrind candidates list',
+ 'No appropriate valgrind executable could be found',
+ ],
+ action => [ ],
+ tool => [ ],
+ command => [ ],
+ run => [
+ 'No compatible suppressions available',
+ ],
+);
+
+my %filter_errors;
+
+for my $obj (keys %skippable_errors) {
+ my @errors = @{$skippable_errors{$obj} || []};
+ if (@errors) {
+ my $rxp = join '|', @errors;
+ $rxp = qr/($rxp)\s+at.*/;
+ $filter_errors{$obj} = sub {
+ my ($err) = @_;
+ if ($err =~ /$rxp/) {
+ return ($1, 1);
+ } else {
+ return ($err, 0);
+ }
+ };
+ } else {
+ $filter_errors{$obj} = sub {
+ return ($_[0], 0);
+ };
+ }
+}
+
+sub _default_abort {
+ my ($err) = @_;
+
+ require Test::Builder;
+ my $tb = Test::Builder->new;
+ my $plan = $tb->has_plan;
+ if (defined $plan) {
+ $tb->BAIL_OUT($err);
+ return 255;
+ } else {
+ $tb->skip_all($err);
+ return 0;
+ }
+}
+
+sub analyse {
+ shift;
+
+ my %args = @_;
+
+ my $instanceof = sub {
+ require Scalar::Util;
+ Scalar::Util::blessed($_[0]) && $_[0]->isa($_[1]);
+ };
+
+ my $tool = delete $args{tool};
+ unless ($tool->$instanceof('Test::Valgrind::Tool')) {
+ require Test::Valgrind::Tool;
+ local $@;
+ $tool = eval {
+ Test::Valgrind::Tool->new(
+ tool => $tool || 'memcheck',
+ callers => delete $args{callers},
+ );
+ };
+ unless ($tool) {
+ my ($err, $skippable) = $filter_errors{tool}->($@);
+ _croak($err) unless $skippable;
+ return _default_abort($err);
+ }
+ }
+
+ require Test::Valgrind::Session;
+ my $sess = eval {
+ Test::Valgrind::Session->new(
+ min_version => $tool->requires_version,
+ map { $_ => delete $args{$_} } qw<
+ regen_def_supp
+ no_def_supp
+ allow_no_supp
+ extra_supps
+ >
+ );
+ };
+ unless ($sess) {
+ my ($err, $skippable) = $filter_errors{session}->($@);
+ _croak($err) unless $skippable;
+ return _default_abort($err);
+ }
+
+ my $action = delete $args{action};
+ unless ($action->$instanceof('Test::Valgrind::Action')) {
+ require Test::Valgrind::Action;
+ local $@;
+ $action = eval {
+ Test::Valgrind::Action->new(
+ action => $action || 'Test',
+ diag => delete $args{diag},
+ );
+ };
+ unless ($action) {
+ my ($err, $skippable) = $filter_errors{action}->($@);
+ _croak($err) unless $skippable;
+ return _default_abort($err);
+ }
+ }
+
+ my $cmd = delete $args{command};
+ unless ($cmd->$instanceof('Test::Valgrind::Command')) {
+ require Test::Valgrind::Command;
+ local $@;
+ $cmd = eval {
+ Test::Valgrind::Command->new(
+ command => $cmd || 'PerlScript',
+ file => delete $args{file},
+ args => [ '-MTest::Valgrind=run,1' ],
+ );
+ };
+ unless ($cmd) {
+ my ($err, $skippable) = $filter_errors{command}->($@);
+ _croak($err) unless $skippable;
+ $action->abort($sess, $err);
+ return $action->status($sess);
+ }
+ }
+
+ {
+ local $@;
+ eval {
+ $sess->run(
+ command => $cmd,
+ tool => $tool,
+ action => $action,
+ );
+ 1
+ } or do {
+ my ($err, $skippable) = $filter_errors{run}->($@);
+ if ($skippable) {
+ $action->abort($sess, $err);
+ return $action->status($sess);
+ } else {
+ require Test::Valgrind::Report;
+ $action->report($sess, Test::Valgrind::Report->new_diag($@));
+ }
+ }
+ }
+
+ my $status = $sess->status;
+ $status = 255 unless defined $status;
+
+ return $status;
+}
+
+=head2 C<import>
+
+ use Test::Valgrind %options;
+
+In the parent process, L</import> calls L</analyse> with the arguments it received itself - except that if no C<file> option was supplied, it tries to pick the first caller context that looks like a script.
+When the analysis ends, it exits with the status returned by the action (for the default TAP-generator action, it's the number of failed tests).
+
+In the child process, it just C<return>s so that the calling code is actually run under C<valgrind>, albeit two side-effects :
+
+=over 4
+
+=item *
+
+L<Perl::Destruct::Level> is loaded and the destruction level is set to C<3>.
+
+=item *
+
+Autoflush on C<STDOUT> is turned on.
+