File Coverage

blib/lib/Test/UnixExit.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	18	18	100.0
condition	3	3	100.0
subroutine	8	8	100.0
pod	2	2	100.0
total	70	70	100.0

# -*- Perl -*-

package Test::UnixExit;
use 5.006;
use strict;
use warnings;
use Carp qw(croak);
use Test::Builder;

our $VERSION = '0.02';

require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK);
@ISA       = qw(Exporter);
@EXPORT    = qw(exit_is);
@EXPORT_OK = qw(exit_is_nonzero);

my $test = Test::Builder->new;

sub exit_is {
    my ( $status, $expect, $name ) = @_;

    unless ( defined $status and defined $expect ) {
        croak "Usage: status expected-value [test-name]";
    }

    my $ref = ref $expect;
    if ( $ref ne '' ) {
        croak "expected-value must be integer or hash reference" unless $ref eq 'HASH';
    } elsif ( $expect =~ m/^[0-9]+$/ ) {
        $expect = { code => $expect };
    } else {
        croak "expected-value must be integer or hash reference";
    }

    my @sigattr = qw(code signal iscore);

    my %got = (
        code   => $status >> 8,
        signal => $status & 127,
        iscore => $status & 128 ? 1 : 0
    );

    my $passed = 1;
    for my $attr (@sigattr) {
        $expect->{$attr} = 0 unless defined $expect->{$attr};
        $passed = 0 if $got{$attr} != $expect->{$attr};
    }
    $test->ok( $passed, $name );

    # verbose by default as signal failures are rare (for me) and may be
    # hard to reproduce
    $test->diag(
        sprintf
          "Got:      code=%-3d signal=%-2d iscore=%d\nExpected: code=%-3d signal=%-2d iscore=%d\n",
        map( { $got{$_} } @sigattr ),
        map( { $expect->{$_} } @sigattr )
    ) unless $passed;

    return $passed;
}

# for any non-zero exit code make the exit code 1
sub exit_is_nonzero {
    my ($status) = @_;
    $status = 256 | ( $status & 255 ) unless $status >> 8 == 0;
    return $status;
}

1;
__END__