testing exit in Perl modules

szabgab has asked for the wisdom of the Perl Monks concerning the following question:

I maintain a Perl script with calls to exit within some of its modules. I wanted to write a few tests for this module. I looked at Test::Exception but if I understand it it handles die but does not handle exit. So I played with the code and slightly based on Test::Exception I wrote the following. I still don't like the BEGIN block but I could not get rid of it.

The test script

use Test::More tests => 3;
ok(1, "Before");

BEGIN {
        package M;
        use TE;
        package main;
}
use TE;
use M;

exits_ok( sub {f()}, -2, "exits");
ok(1, "After");
[download]

The M.pm module

package M;
use strict;
require Exporter;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(f);

sub f {
        exit(-1);
}


1;
[download]

The TE (short for Test::Exit ?) module

package TE;
use strict;
require Exporter;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(exit exits_ok);

use Test::Builder;
my $Test = Test::Builder->new();


sub exit {
   my ($arg) = @_;
   $arg = '' if not defined $arg;
   die "EXIT$arg\n";
}

sub exits_ok (&$;$$) {
    my ($coderef, $expecting, $description) = @_;
    $expecting     = '' if not defined $expecting;
    $description ||= "exit $expecting";
    my $result;
    eval {&$coderef};
    my $ex = $@;
    $Test->ok($ex and $ex eq "EXIT$expecting\n", $description);
    if ($ex) {
        if ($ex =~ /^EXIT(.*)/) {
           if ($1 ne $expecting) {
              $Test->diag("Received '$1' expected '$expecting'");
           }
        } else {
           $Test->diag("died before reaching an exit statement");
        }
    }
}

1;
[download]

Your input (or a pointer for an earlier and better implementation of this wheel) is appreciated.

Comment on testing exit in Perl modules Select or Download Code

Replies are listed 'Best First'.
Re: testing exit in Perl modules by adrianh (Chancellor) on Jul 20, 2005 at 16:19 UTC
Your input (or a pointer for an earlier and better implementation of this wheel) is appreciated. The problem with this approach (turning the exit into a die) is that it can fall down if there are other bits of exception handling code that could catch the exception thrown by exit. Some suggestions: If you're not worried about cross-platform code, and you're running on unix boxes, fork of a separate process for the code under test and look at the actual exit value. Redefine exit so that it does the test you want, then does a normal exit. Obviously this means that you'll have to have this as your last/only test in the script. Use an END block - again this means the exit test will have to be the last/only test in the script. The last option is probably the simplest cross-platform mechanism - something like this (untested) should do the job. `use strict; use warnings; use Test::More tests => 1; use M; f(); END { is( $?, -1, 'f() exited with -1' ) }` [download]	[reply] [d/l]
Re: testing exit in Perl modules by chromatic (Archbishop) on Jul 20, 2005 at 17:50 UTC
You can remove the `BEGIN` block if you use `use_ok()` (not in a `BEGIN` block) to load the module being tested. Like adrianh, I'm not sure why you changed `exit` into `die`. I usually set it to a closure so I can test the arguments that came in and set the return value. I also use the subs pragma instead of merely defining the subroutine. That way, if someone's used it without parenthesis, it still works. (I have a memory of an edge case somewhere, but it might be the prototype issue on built-ins.)	[reply] [d/l] [select]