comment on

execute it via the "system" call

It's easy to do this non-portably. For example, if you rely on the script being executable and having a shebang line, this won't work on Windows unless .pl file associations have been set up.

I've done a fair amount of script testing and always set up an explicit call to perl, usually with Probe::Perl and relying on IPC::Run3 to execute the program and manage input and output.

For example:

use strict;
use File::Spec;
use IPC::Run3 qw/run3/;
use Probe::Perl;
use Test::More;

plan tests =>  2 ;

my $perl = Probe::Perl->find_perl_interpreter;

my $script = File::Spec->catfile(qw/scripts foo.pl/);

my ($got_stdout, $got_stderr);

ok( -r $script, 
    "foo.pl script readable" 
);

# run and capture output
run3 "$perl $script", undef, \$got_stdout, \$got_stderr;

is( $got_stdout, $expected_stdout),
    "foo.pl program output"
);
[download]

You can see an example like that in my Tee distribution in 02_tee_script.t.

In some cases, I've written an entire test helper class to manage repetitive tests on a script. In Pod::WikiDoc, I have a file called t/CLI.pm and I use it for repeated calls to a script with different command line options, plus it automatically captures output and has tests for whether it ran successfully or not.

use t::CLI;
my $script = File::Spec->catfile( "scripts", "wikidoc" );
my $wikidoc = t::CLI->new($script);

# setup $input_file and $output_file

$wikidoc->runs_ok( "$input_file", "$output_file" );

$wikidoc->stdout_like( qr/Extracting Pod from \Q$input_file\E/,
    "'wikidoc file file' status message"
);
[download]

Here's is a copy of t::CLI:

package t::CLI;
use strict;
use warnings;

use Test::Builder;
use Probe::Perl;
use Cwd qw( abs_path );
use IPC::Run3;
use File::Basename qw( basename );
use File::Spec;
#use POSIX qw( WEXITSTATUS );

my $Test = Test::Builder->new;
my $pp = Probe::Perl->new;
my $perl = abs_path($pp->find_perl_interpreter);
my $cwd = abs_path( "." );
my $coverdb = File::Spec->catdir($cwd,"cover_db");
my $cover = index( ($ENV{HARNESS_PERL_SWITCHES} || ''), '-MDevel::Cove
+r' ) < 0
          ? ''
          : "-MDevel::Cover=-db,$coverdb"
          ;
#---------------------------------------------------------------------
+-----#
# Main API
#---------------------------------------------------------------------
+-----#

sub new {
    my ($class, $program, @default_args ) = @_;
    my $self = bless {}, $class;
    $self->program( $program );
    $self->default_args( [@default_args] );
    return $self;
}

# returns success or failure; exit_code is opposite (0 is good); actua
+l error
# message is in @$
sub run {
    my ($self, @args) = @_;
    my ($stdout, $stderr);
    my $stdin = $self->stdin;

    my @cmd = (
        $perl, 
        "-Mblib=$cwd", # must hard code this in case curdir changed
        ( $cover ? $cover : () ),
        $self->{program},
        @{ $self->default_args() },
        @args,
    );
                
    eval {
        run3 \@cmd, \$stdin, \$stdout, \$stderr;
        $self->exit_code( $? >> 8 || 0 );
    };
    my $result = $@ eq q{} ? 1 : 0;
    $self->stdout($stdout);
    $self->stderr($stderr);
    $@ .= "(running '@cmd')";
    return $result;
}

#---------------------------------------------------------------------
+-----#
# Accessors
#---------------------------------------------------------------------
+-----#

sub program {
    my ($self, $filename) = @_;
    if (defined $filename) {
        die "Can't find $filename" if ! -e $filename;
        $self->{program} = abs_path($filename);
    }
    return basename( $self->{program} );
}
        
BEGIN {
    my $evaltext = << 'CODE';
        sub {
            $_[0]->{PROP} = $_[1] if @_ > 1;
            return $_[0]->{PROP};
        }
CODE
    for ( qw( exit_code stdin stdout stderr default_args)) {
        no strict 'refs';
        (my $sub = $evaltext) =~ s/PROP/$_/g;
        *{__PACKAGE__ . "::$_"} = eval $sub;
    }
}

#---------------------------------------------------------------------
+-----#
# Testing functions
#---------------------------------------------------------------------
+-----#

sub runs_ok {
    my ($self, @args) = @_;
    my $label = "Ran " . $self->program() . " with "
              . (@args && $args[0] ne q{} ? "args '@args'" : "no args"
+ )
              . " without error";
    my $runs = $self->run(@args);
    die $@ if ! $runs;
    my $ok = $Test->ok( ! $self->exit_code, $label );
    if ( ! $ok ) {
        $Test->diag( "Exit code: " . $self->exit_code . "\n");
        $Test->diag( "STDERR: " . $self->stderr . "\n") if $self->stde
+rr;
        $Test->diag( "STDOUT: " . $self->stdout . "\n") if $self->stdo
+ut;
    }
    return $ok;
}

sub dies_ok {
    my ($self, @args) = @_;
    my $label = $self->program . " with "
              . (@args && $args[0] ne q{} ? "args '@args'" : "no args"
+ )
              . " ended with an error";
    my $runs = $self->run(@args);
    die $@ if ! $runs;
    my $ok = $Test->ok( $self->exit_code, $label );
    if ( ! $ok ) {
        $Test->diag( "Exit code: " . $self->exit_code . "\n");
    }
    return $ok;
}


sub exits_with {
    my ($self, $expect, @args) = @_;
    my $label = $self->program . " with "
              . (@args && $args[0] ne q{} ? "args '@args'" : "no args"
+ )
              . " ended with exit code $expect";
    my $runs = $self->run(@args);
    die $@ if ! $runs;
    return $Test->is_num( $self->exit_code, $expect, $label );
}

sub stdout_is { my ($self, $expect, $label) = @_; return $Test->is_eq(
        $self->stdout, $expect, $label ? "... $label" : "... " . $self
+->program
        . " had correct output to STDOUT" ); }

sub stdout_like {
    my ($self, $expect, $label) = @_;
    return $Test->like( $self->stdout, $expect, 
        $label 
            ? "... $label"
            : "... " . $self->program . " had correct output to STDOUT
+" );
}

sub stderr_is {
    my ($self, $expect, $label) = @_;
    return $Test->is_eq( $self->stderr, $expect,
        $label 
            ? "... $label"
            : "... " . $self->program . " had correct output to STDERR
+" );
}

sub stderr_like {
    my ($self, $expect, $label) = @_;
    return $Test->like( $self->stderr, $expect,
        $label 
            ? "... $label"
            : "... " . $self->program . " had correct output to STDERR
+" );
}


1; #true
[download]

You can see that in use in t/70-wikidoc-script.t.

I hope that gives you some useful ideas.

-xdg

Code written by xdg and posted on PerlMonks is public domain. It is provided as is with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.

In reply to Re: How to unit test a script packaged in a module distribution? by xdg
in thread How to unit test a script packaged in a module distribution? by vbar

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Your skill will accomplish what the force of many cannot
	PerlMonks