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

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.