File Coverage

blib/lib/Test/Exec.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	2	2	100.0
condition	4	5	80.0
subroutine	11	11	100.0
pod	2	2	100.0
total	56	57	98.2

package Test::Exec;

use strict;
use warnings;
use Test2::API qw( context );
use Return::MultiLevel qw( with_return );
use base 'Exporter';

# ABSTRACT: Test that some code calls exec without terminating testing
our $VERSION = '0.04'; # VERSION


our @EXPORT = qw( exec_arrayref never_exec_ok );

our $exec_handler = sub {
  CORE::exec(@_);
};
BEGIN {
  *CORE::GLOBAL::exec = sub { $exec_handler->(@_) };
}


my $last;

sub exec_arrayref(&)
{
  my($code) = @_;

  undef $last;

  return with_return {
    my($return) = @_;
    local $exec_handler = sub {
      $last = [caller(1)];
      $return->([@_]);
    };
    $code->();
    undef;
  };
}


sub never_exec_ok (&;$)
{
  my($code, $name) = @_;

  $name ||= 'does not call exec';

  my $ret = exec_arrayref { $code->() };
  my $ok = !defined $ret;

  my $ctx = context();
  $ctx->ok($ok, $name);

  if(!$ok && $last)
  {
    my($package, $filename, $line) = @$last;
    $ctx->diag("exec at $filename line $line");
  }

  $ctx->release;
}

1;

__END__