File Coverage

blib/lib/Test/Exec.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	2	2	100.0
condition	4	5	80.0
subroutine	11	11	100.0
pod	2	2	100.0
total	59	60	98.3

package Test::Exec;

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

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


our @EXPORT = qw( exec_arrayref never_exec_ok );


my $last;

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

  undef $last;

  return with_return {
    my($return) = @_;
    local $Test2::Tools::Process::handlers{exec} = 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(undef, $filename, $line) = @$last;
    $ctx->diag("exec at $filename line $line");
  }

  $ctx->release;
}

1;

__END__