r35115 - in /branches/upstream/libtest-command-perl/current: Changes MANIFEST META.yml lib/Test/Command.pm t/02-exit.t t/05-object.t t/06-signal.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun May 10 15:51:52 UTC 2009
Author: ansgar-guest
Date: Sun May 10 15:51:42 2009
New Revision: 35115
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=35115
Log:
[svn-upgrade] Integrating new upstream version, libtest-command-perl (0.03)
Added:
branches/upstream/libtest-command-perl/current/t/06-signal.t
Modified:
branches/upstream/libtest-command-perl/current/Changes
branches/upstream/libtest-command-perl/current/MANIFEST
branches/upstream/libtest-command-perl/current/META.yml
branches/upstream/libtest-command-perl/current/lib/Test/Command.pm
branches/upstream/libtest-command-perl/current/t/02-exit.t
branches/upstream/libtest-command-perl/current/t/05-object.t
Modified: branches/upstream/libtest-command-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-command-perl/current/Changes?rev=35115&op=diff
==============================================================================
--- branches/upstream/libtest-command-perl/current/Changes (original)
+++ branches/upstream/libtest-command-perl/current/Changes Sun May 10 15:51:42 2009
@@ -1,4 +1,11 @@
Revision history for Test-Command
+
+0.03 Sat May 9 32:21:12 2009
+ - use POSIX::WEXITSTATUS() to find exit status instead of manual bit shift
+ - added terminating signal handling via POSIX::WTERMSIG() (was mentioned in
+ "DEVELOPMENT IDEAS" but finally spurred on by Lanny Ripple via
+ http://rt.cpan.org/Public/Bug/Display.html?id=43541)
+ - added t/06-signal.t
0.02 Tue Apr 10 21:58:20 2007
- added 'tests => 11' import to 'use Test::Command' in SYNOPSIS
Modified: branches/upstream/libtest-command-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-command-perl/current/MANIFEST?rev=35115&op=diff
==============================================================================
--- branches/upstream/libtest-command-perl/current/MANIFEST (original)
+++ branches/upstream/libtest-command-perl/current/MANIFEST Sun May 10 15:51:42 2009
@@ -11,5 +11,6 @@
t/03-stdout.t
t/04-stderr.t
t/05-object.t
+t/06-signal.t
t/pod-coverage.t
t/pod.t
Modified: branches/upstream/libtest-command-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-command-perl/current/META.yml?rev=35115&op=diff
==============================================================================
--- branches/upstream/libtest-command-perl/current/META.yml (original)
+++ branches/upstream/libtest-command-perl/current/META.yml Sun May 10 15:51:42 2009
@@ -1,6 +1,6 @@
---
name: Test-Command
-version: 0.02
+version: 0.03
author:
- 'Daniel B. Boorstein <danboo at cpan.org>'
abstract: Test routines for external commands
@@ -12,8 +12,8 @@
provides:
Test::Command:
file: lib/Test/Command.pm
- version: 0.02
-generated_by: Module::Build version 0.2806
+ version: 0.03
+generated_by: Module::Build version 0.280802
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2
Modified: branches/upstream/libtest-command-perl/current/lib/Test/Command.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-command-perl/current/lib/Test/Command.pm?rev=35115&op=diff
==============================================================================
--- branches/upstream/libtest-command-perl/current/lib/Test/Command.pm (original)
+++ branches/upstream/libtest-command-perl/current/lib/Test/Command.pm Sun May 10 15:51:42 2009
@@ -5,6 +5,7 @@
use Carp qw/ confess /;
use File::Temp qw/ tempfile /;
+use POSIX qw(:sys_wait_h);
use base 'Test::Builder::Module';
@@ -12,6 +13,10 @@
exit_is_num
exit_isnt_num
exit_cmp_ok
+
+ signal_is_num
+ signal_isnt_num
+ signal_cmp_ok
stdout_is_eq
stdout_isnt_eq
@@ -39,15 +44,15 @@
=head1 VERSION
-Version 0.02
-
-=cut
-
-our $VERSION = '0.02';
+Version 0.03
+
+=cut
+
+our $VERSION = '0.03';
=head1 SYNOPSIS
-Test the exit status, STDOUT or STDERR of an external command.
+Test the exit status, signal, STDOUT or STDERR of an external command.
use Test::Command tests => 11;
@@ -61,6 +66,12 @@
$cmd = 'false';
exit_isnt_num($cmd, 0);
+
+ ## testing terminating signal
+
+ $cmd = 'true';
+
+ signal_is_num($cmd, 0);
## testing STDOUT
@@ -86,6 +97,7 @@
my $echo_test = Test::Command->new( cmd => 'echo out' );
$echo_test->exit_is_num(0);
+ $echo_test->signal_is_num(0);
$echo_test->stdout_is_eq("out\n");
## force a re-run of the command
@@ -96,8 +108,8 @@
C<Test::Command> intends to bridge the gap between the well tested functions and
objects you choose and their usage in your programs. By examining the exit
-status, STDOUT and STDERR of your program you can determine if it is behaving as
-expected.
+status, terminating signal, STDOUT and STDERR of your program you can determine
+if it is behaving as expected.
This includes testing the various combinations and permutations of options and
arguments as well as the interactions between the various functions and objects
@@ -187,11 +199,12 @@
{
my ($self) = @_;
- my ($exit_status, $stdout_file, $stderr_file) = _run_cmd( $self->{'cmd'} );
-
- $self->{'result'}{'exit_status'} = $exit_status;
- $self->{'result'}{'stdout_file'} = $stdout_file;
- $self->{'result'}{'stderr_file'} = $stderr_file;
+ my $run_info = _run_cmd( $self->{'cmd'} );
+
+ $self->{'result'}{'exit_status'} = $run_info->{'exit_status'};
+ $self->{'result'}{'term_signal'} = $run_info->{'term_signal'};
+ $self->{'result'}{'stdout_file'} = $run_info->{'stdout_file'};
+ $self->{'result'}{'stderr_file'} = $run_info->{'stderr_file'};
return $self;
@@ -341,9 +354,7 @@
$cmd->run;
}
- return @{ $cmd->{'result'} }{ qw/ exit_status
- stdout_file
- stderr_file / };
+ return $cmd->{'result'};
}
else
{
@@ -381,7 +392,9 @@
open STDERR, '>&' . fileno $temp_stderr_fh or confess 'Cannot duplicate temporary STDERR';
## run the command
- my $exit_status = system(@{ $cmd }) >> 8;
+ my $system_return = system(@{ $cmd });
+ my $exit_status = WEXITSTATUS($system_return);
+ my $term_signal = WTERMSIG($system_return);
## close and restore STDOUT and STDERR to original handles
close STDOUT or confess "failed to close STDOUT: $!";
@@ -389,7 +402,10 @@
open STDOUT, '>&' . fileno $saved_stdout or confess 'Cannot restore STDOUT';
open STDERR, '>&' . fileno $saved_stderr or confess 'Cannot restore STDERR';
- return ($exit_status, $temp_stdout_file, $temp_stderr_file);
+ return { exit_status => $exit_status,
+ term_signal => $term_signal,
+ stdout_file => $temp_stdout_file,
+ stderr_file => $temp_stderr_file };
}
@@ -411,11 +427,11 @@
{
my ($cmd, $exp, $name) = @_;
- my ($exit_status) = _get_result($cmd);
-
- $name = _build_name($name, @_);
-
- return __PACKAGE__->builder->is_num($exit_status, $exp, $name);
+ my $result = _get_result($cmd);
+
+ $name = _build_name($name, @_);
+
+ return __PACKAGE__->builder->is_num($result->{'exit_status'}, $exp, $name);
}
=head3 exit_isnt_num
@@ -431,11 +447,11 @@
{
my ($cmd, $not_exp, $name) = @_;
- my ($exit_status) = _get_result($cmd);
-
- $name = _build_name($name, @_);
-
- return __PACKAGE__->builder->isnt_num($exit_status, $not_exp, $name);
+ my $result = _get_result($cmd);
+
+ $name = _build_name($name, @_);
+
+ return __PACKAGE__->builder->isnt_num($result->{'exit_status'}, $not_exp, $name);
}
=head3 exit_cmp_ok
@@ -452,11 +468,77 @@
{
my ($cmd, $op, $exp, $name) = @_;
- my ($exit_status) = _get_result($cmd);
-
- $name = _build_name($name, @_);
-
- return __PACKAGE__->builder->cmp_ok($exit_status, $op, $exp, $name);
+ my $result = _get_result($cmd);
+
+ $name = _build_name($name, @_);
+
+ return __PACKAGE__->builder->cmp_ok($result->{'exit_status'}, $op, $exp, $name);
+ }
+
+=head2 Testing Terminating Signal
+
+The test routines below compare against the lower 8 bits of the exit status
+of the executed command.
+
+=head3 signal_is_num
+
+ signal_is_num($cmd, $exp_num, $name)
+
+If the terminating signal of the command is numerically equal to the expected number,
+this passes. Otherwise it fails.
+
+=cut
+
+sub signal_is_num
+ {
+ my ($cmd, $exp, $name) = @_;
+
+ my $result = _get_result($cmd);
+
+ $name = _build_name($name, @_);
+
+ return __PACKAGE__->builder->is_num($result->{'term_signal'}, $exp, $name);
+ }
+
+=head3 signal_isnt_num
+
+ signal_isnt_num($cmd, $unexp_num, $name)
+
+If the terminating signal of the command is B<not> numerically equal to the given
+number, this passes. Otherwise it fails.
+
+=cut
+
+sub signal_isnt_num
+ {
+ my ($cmd, $not_exp, $name) = @_;
+
+ my $result = _get_result($cmd);
+
+ $name = _build_name($name, @_);
+
+ return __PACKAGE__->builder->isnt_num($result->{'term_signal'}, $not_exp, $name);
+ }
+
+=head3 signal_cmp_ok
+
+ signal_cmp_ok($cmd, $op, $operand, $name)
+
+If the terminating signal of the command is compared with the given operand
+using the given operator, and that operation returns true, this passes. Otherwise
+it fails.
+
+=cut
+
+sub signal_cmp_ok
+ {
+ my ($cmd, $op, $exp, $name) = @_;
+
+ my $result = _get_result($cmd);
+
+ $name = _build_name($name, @_);
+
+ return __PACKAGE__->builder->cmp_ok($result->{'term_signal'}, $op, $exp, $name);
}
=head2 Testing STDOUT
@@ -477,9 +559,9 @@
{
my ($cmd, $exp, $name) = @_;
- my (undef, $stdout_file) = _get_result($cmd);
-
- my $stdout_text = _slurp($stdout_file);
+ my $result = _get_result($cmd);
+
+ my $stdout_text = _slurp($result->{'stdout_file'});
$name = _build_name($name, @_);
@@ -499,9 +581,9 @@
{
my ($cmd, $not_exp, $name) = @_;
- my (undef, $stdout_file) = _get_result($cmd);
-
- my $stdout_text = _slurp($stdout_file);
+ my $result = _get_result($cmd);
+
+ my $stdout_text = _slurp($result->{'stdout_file'});
$name = _build_name($name, @_);
@@ -521,9 +603,9 @@
{
my ($cmd, $exp, $name) = @_;
- my (undef, $stdout_file) = _get_result($cmd);
-
- my $stdout_text = _slurp($stdout_file);
+ my $result = _get_result($cmd);
+
+ my $stdout_text = _slurp($result->{'stdout_file'});
$name = _build_name($name, @_);
@@ -543,9 +625,9 @@
{
my ($cmd, $not_exp, $name) = @_;
- my (undef, $stdout_file) = _get_result($cmd);
-
- my $stdout_text = _slurp($stdout_file);
+ my $result = _get_result($cmd);
+
+ my $stdout_text = _slurp($result->{'stdout_file'});
$name = _build_name($name, @_);
@@ -565,9 +647,9 @@
{
my ($cmd, $exp, $name) = @_;
- my (undef, $stdout_file) = _get_result($cmd);
-
- my $stdout_text = _slurp($stdout_file);
+ my $result = _get_result($cmd);
+
+ my $stdout_text = _slurp($result->{'stdout_file'});
$name = _build_name($name, @_);
@@ -587,9 +669,9 @@
{
my ($cmd, $exp, $name) = @_;
- my (undef, $stdout_file) = _get_result($cmd);
-
- my $stdout_text = _slurp($stdout_file);
+ my $result = _get_result($cmd);
+
+ my $stdout_text = _slurp($result->{'stdout_file'});
$name = _build_name($name, @_);
@@ -610,9 +692,9 @@
{
my ($cmd, $op, $exp, $name) = @_;
- my (undef, $stdout_file) = _get_result($cmd);
-
- my $stdout_text = _slurp($stdout_file);
+ my $result = _get_result($cmd);
+
+ my $stdout_text = _slurp($result->{'stdout_file'});
$name = _build_name($name, @_);
@@ -633,10 +715,10 @@
{
my ($cmd, $exp_file, $name) = @_;
- my (undef, $got_file) = _get_result($cmd);
+ my $result = _get_result($cmd);
my ($ok, $diff_start, $got_line, $exp_line, $col_mark) =
- _compare_files($got_file, $exp_file);
+ _compare_files($result->{'stdout_file'}, $exp_file);
$name = _build_name($name, @_);
@@ -674,9 +756,9 @@
{
my ($cmd, $exp, $name) = @_;
- my (undef, undef, $stderr_file) = _get_result($cmd);
-
- my $stderr_text = _slurp($stderr_file);
+ my $result = _get_result($cmd);
+
+ my $stderr_text = _slurp($result->{'stderr_file'});
$name = _build_name($name, @_);
@@ -696,9 +778,9 @@
{
my ($cmd, $not_exp, $name) = @_;
- my (undef, undef, $stderr_file) = _get_result($cmd);
-
- my $stderr_text = _slurp($stderr_file);
+ my $result = _get_result($cmd);
+
+ my $stderr_text = _slurp($result->{'stderr_file'});
$name = _build_name($name, @_);
@@ -718,9 +800,9 @@
{
my ($cmd, $exp, $name) = @_;
- my (undef, undef, $stderr_file) = _get_result($cmd);
-
- my $stderr_text = _slurp($stderr_file);
+ my $result = _get_result($cmd);
+
+ my $stderr_text = _slurp($result->{'stderr_file'});
$name = _build_name($name, @_);
@@ -740,9 +822,9 @@
{
my ($cmd, $not_exp, $name) = @_;
- my (undef, undef, $stderr_file) = _get_result($cmd);
-
- my $stderr_text = _slurp($stderr_file);
+ my $result = _get_result($cmd);
+
+ my $stderr_text = _slurp($result->{'stderr_file'});
$name = _build_name($name, @_);
@@ -762,9 +844,9 @@
{
my ($cmd, $exp, $name) = @_;
- my (undef, undef, $stderr_file) = _get_result($cmd);
-
- my $stderr_text = _slurp($stderr_file);
+ my $result = _get_result($cmd);
+
+ my $stderr_text = _slurp($result->{'stderr_file'});
$name = _build_name($name, @_);
@@ -784,9 +866,9 @@
{
my ($cmd, $exp, $name) = @_;
- my (undef, undef, $stderr_file) = _get_result($cmd);
-
- my $stderr_text = _slurp($stderr_file);
+ my $result = _get_result($cmd);
+
+ my $stderr_text = _slurp($result->{'stderr_file'});
$name = _build_name($name, @_);
@@ -807,9 +889,9 @@
{
my ($cmd, $op, $exp, $name) = @_;
- my (undef, undef, $stderr_file) = _get_result($cmd);
-
- my $stderr_text = _slurp($stderr_file);
+ my $result = _get_result($cmd);
+
+ my $stderr_text = _slurp($result->{'stderr_file'});
$name = _build_name($name, @_);
@@ -830,10 +912,10 @@
{
my ($cmd, $exp_file, $name) = @_;
- my (undef, undef, $got_file) = _get_result($cmd);
+ my $result = _get_result($cmd);
my ($ok, $diff_start, $got_line, $exp_line, $col_mark) =
- _compare_files($got_file, $exp_file);
+ _compare_files($result->{'stderr_file'}, $exp_file);
$name = _build_name($name, @_);
@@ -923,8 +1005,6 @@
=back
-=item * make use of POSIX::W* constants and macros to test exit by signal
-
=item * potential test functions:
=over 3
Modified: branches/upstream/libtest-command-perl/current/t/02-exit.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-command-perl/current/t/02-exit.t?rev=35115&op=diff
==============================================================================
--- branches/upstream/libtest-command-perl/current/t/02-exit.t (original)
+++ branches/upstream/libtest-command-perl/current/t/02-exit.t Sun May 10 15:51:42 2009
@@ -1,6 +1,6 @@
#!perl
-use Test::Command tests => 4;
+use Test::Command tests => 5;
use Test::More;
@@ -10,6 +10,7 @@
exit_is_num(qq($^X -e "exit 1"), 1);
exit_is_num(qq($^X -e "exit 255"), 255);
+exit_is_num(qq($^X -MPOSIX -e "POSIX::raise( &POSIX::SIGTERM )"), 0 );
exit_isnt_num(qq($^X -e 1), 2);
Modified: branches/upstream/libtest-command-perl/current/t/05-object.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-command-perl/current/t/05-object.t?rev=35115&op=diff
==============================================================================
--- branches/upstream/libtest-command-perl/current/t/05-object.t (original)
+++ branches/upstream/libtest-command-perl/current/t/05-object.t Sun May 10 15:51:42 2009
@@ -1,6 +1,6 @@
#!perl
-use Test::More tests => 26;
+use Test::More tests => 29;
use Test::Command;
@@ -21,6 +21,10 @@
$test_perl->exit_is_num(0);
$test_perl->exit_isnt_num(1);
$test_perl->exit_cmp_ok('<', 1);
+
+$test_perl->signal_is_num(0);
+$test_perl->signal_isnt_num(1);
+$test_perl->signal_cmp_ok('<', 1);
$test_perl->stdout_is_eq("foo\nbar\n");
$test_perl->stdout_isnt_eq("bar\nfoo\n");
Added: branches/upstream/libtest-command-perl/current/t/06-signal.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-command-perl/current/t/06-signal.t?rev=35115&op=file
==============================================================================
--- branches/upstream/libtest-command-perl/current/t/06-signal.t (added)
+++ branches/upstream/libtest-command-perl/current/t/06-signal.t Sun May 10 15:51:42 2009
@@ -1,0 +1,20 @@
+#!perl
+
+use Test::Command tests => 6;
+
+use Test::More;
+
+use POSIX;
+
+## determine whether we can run perl or not
+
+system qq($^X -e 1) and BAIL_OUT('error calling perl via system');
+
+signal_is_num(qq($^X -e "exit 0"), 0);
+signal_is_num(qq($^X -e "exit 1"), 0);
+signal_is_num(qq($^X -e "exit 255"), 0);
+signal_is_num(qq($^X -MPOSIX -e "POSIX::raise( &POSIX::SIGTERM )"), &POSIX::SIGTERM );
+
+signal_isnt_num(qq($^X -e 1), 1);
+
+signal_cmp_ok(qq($^X -e "exit 1"), '<', 2);
More information about the Pkg-perl-cvs-commits
mailing list