File Coverage

blib/lib/Test/UnixExit.pm

Criterion	Covered	Total	%
statement	33	38	86.8
branch	10	14	71.4
condition	3	6	50.0
subroutine	7	7	100.0
pod	1	1	100.0
total	54	66	81.8

# -*- Perl -*-
#
# Tests exit status words

package Test::UnixExit;

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

our $VERSION = '0.01';

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

my $test = Test::Builder->new;
my @keys = qw(code signal iscore);

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

    croak "Usage: status expected-value test-name"
      if !defined $status
      or !defined $expected_value;

    if ( $expected_value =~ m/^[0-9]+$/ ) {
        $expected_value = { code => $expected_value };
    } elsif ( ref $expected_value ne 'HASH' ) {
        croak "expected-value must be integer or hash reference";
    }
    for my $key (@keys) {
        $expected_value->{$key} = 0
          if !exists $expected_value->{$key}
          or !defined $expected_value->{$key};
    }

    my $got_value;
    $got_value->{code}   = $status >> 8;
    $got_value->{signal} = $status & 127;
    $got_value->{iscore} = $status & 128 ? 1 : 0;

    my $passed = 1;
    for my $key (@keys) {
        if ( $got_value->{$key} != $expected_value->{$key} ) {
            $passed = 0;
            last;
        }
    }
    $test->ok( $passed, $name );

    $test->diag(
        sprintf
          "Got:      code=%-3d signal=%-2d iscore=%d\nExpected: code=%-3d signal=%-2d iscore=%d\n",
        map( { $got_value->{$_} } @keys ),
        map( { $expected_value->{$_} } @keys )
    ) if !$passed;

    return $passed;
}

1;
__END__