File Coverage

blib/lib/Test/Exit.pm

Criterion	Covered	Total	%
statement	28	28	100.0
branch	2	2	100.0
condition	1	3	33.3
subroutine	12	12	100.0
pod	5	5	100.0
total	48	50	96.0

package Test::Exit;
{
  $Test::Exit::VERSION = '0.11';
}

# ABSTRACT: Test that some code calls exit() without terminating testing

use strict;
use warnings;

use Return::MultiLevel qw(with_return);
use base 'Test::Builder::Module';

our @EXPORT = qw(exit_code exits_ok exits_zero exits_nonzero never_exits_ok);

# We have to install this at compile-time and globally.
# We provide one that does effectively nothing, and then override it locally.
# Of course, if anyone else overrides CORE::GLOBAL::exit as well, bad stuff happens.
our $exit_handler = sub {
  CORE::exit $_[0];
};
BEGIN {
  *CORE::GLOBAL::exit = sub (;$) { $exit_handler->(@_ ? 0 + $_[0] : 0) };
}


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

  return with_return {
    local $exit_handler = $_[0];
    $code->();
    undef
  };
}


sub exits_ok (&;$) {
  my ($code, $description) = @_;

  __PACKAGE__->builder->ok(defined &exit_code($code), $description);
}


sub exits_nonzero (&;$) {
  my ($code, $description) = @_;

  __PACKAGE__->builder->ok(&exit_code($code), $description);
}


sub exits_zero (&;$) {
  my ($code, $description) = @_;

  my $exit = &exit_code($code);
  __PACKAGE__->builder->ok(defined $exit && $exit == 0, $description);
}


sub never_exits_ok (&;$) {
  my ($code, $description) = @_;

  __PACKAGE__->builder->ok(!defined &exit_code($code), $description);
}

1;

__END__