# -*- Perl -*-

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

our $VERSION = '0.03';

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__

=head1 NAME

Test::UnixExit - test exit status words

=head1 SYNOPSIS

  # modules that exit status words could come from
  #use Expect;
  #use Test::Cmd;

  # probably necessary for other tests
  use Test::Most;

  use Test::UnixExit;

  # ... some code here that sets $? here or $expect->exitstatus ...
  exit_is( $?, 0, "exit success" );

  # ... some code here that sets $? here or $expect->exitstatus ...
  exit_is( $?, { code => 0, signal => 2, iscore => 0 }, "SIGINT" );

  # same, but with less typing (unset fields default to 0)
  exit_is( $?, { signal => 2 }, "SIGINT" );

  # turn all nonzero exit codes to 1
  exit_is( Test::UnixExit::exit_is_nonzero($?), 1, "dies okay" );

=head1 DESCRIPTION

NOTE L<Test2::Tools::Command> should be used instead of this module.

This module provides a means to check that the exit status word of a
unix process exactly matches a specific exit code, signal number, and
whether a core was generated; the simple C<<< $? >> 8 == 0 >>> test
ignores two of these three attributes.

  # the incomplete test
  is( $? >> 8, 0 );

  # with this module becomes
  exit_is( $?, 0 );

This code is most useful when testing external commands via C<system>,
L<Test::Cmd>, or L<Expect> and details are required beyond a simple "was
$? zero or not" boolean. Perl code itself may be tested with modules
such as L<Test::Exit> or L<Test::Trap>.

=head1 FUNCTIONS

B<exit_is> is exported by default.

=over 4

=item B<exit_is> I<status> I<expected-value> [ I<test-name> ]

This function accepts a I<status> (the 16-bit return value from the
C<wait(2)> call), an I<expected-value> as either an 8-bit exit code
or a hash reference with various fields set, and an optional name
for the test.

The return value is whether or not the test passed.

The fields for the hash reference are:

  code   => 8-bit exit status number (WEXITSTATUS)
  iscore => 1 or 0 if a core file was created or not
  signal => what signal the process ate (WTERMSIG), if any

Unspecified fields default to C<0>.

=item B<exit_is_nonzero> I<status>

B<exit_is> requires exact values. Use B<exit_is_nonzero> to change
the code of an exit status word to 1 if any non-zero value is present.

Returns the (possibly modified) exit status word.

  # expect failure, but do not know what exit code will be used
  # implicit: no core was generated and no signal was involved
  exit_is( exit_is_nonzero($?), 1 );

If you do not care about the I<signal> or I<iscore> portions of the exit
status word then simpler tests such as

  is(   $?, 0, "expect exit without error" );
  isnt( $?, 0, "expect process to fail" );

may suffice. In that case there is no need for this module. On the other
hand, a program could change from a non-zero exit status word (OK) to
non-zero exit status word with corefile (NOT OK) and you might want to
know about that.

=back

=head1 BUGS

=head2 Reporting Bugs

Patches might best be applied towards:

L<https://github.com/thrig/Test-UnixExit>

=head2 Known Issues

The I<expected-value> to B<exit_is> is not much checked whether the
inputs are sane, e.g. that I<code> is an 8-bit number, etc. This may be
a problem if this input is being generated by something that is buggy.

=head1 SEE ALSO

L<Test::Cmd>, L<Expect> - these provide means to check external
commands, either by running the commands under a shell, or simulating a
terminal environment. Good ways to obtain a C<$?> to pass to this code,
in other words.

L<Test::Exit>, L<Test::Trap> - these check that Perl code behaves in
a particular way, and may be more suitable for testing code in a
module over running a wrapper via the complication of a shell or
virtual terminal.

L<Test2::Suite> and in particular L<Test2::Tools::Command>.

L<sh(1)> vs. L<wait(2)> - note that the shell C<$?> variable differs
from the 16-bit exit status word in that the signal number and core
boolean flag are translated--the verb "mangled" also works here--into an
8-bit value. The Perl C<$?> variable instead contains the 16-bit exit
status word, a difference that can and does cause confusion.

Perl code can adjust C<$?> inside an C<END> subroutine to (try to)
mandate that particular exit codes are used when a process goes away.
This only works if you control the code on that side of the fence.

=head1 AUTHOR

thrig - Jeremy Mates (cpan:JMATES) C<< <jmates at cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2016 by Jeremy Mates

This program is distributed under the (Revised) BSD License:
L<https://www.opensource.org/licenses/BSD-3-Clause>

=cut