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