r67334 - in /branches/upstream/libtest-script-run-perl/current: Changes META.yml lib/Test/Script/Run.pm t/01.run.t
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Wed Jan 12 23:26:25 UTC 2011
Author: periapt-guest
Date: Wed Jan 12 23:26:19 2011
New Revision: 67334
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=67334
Log:
[svn-upgrade] new version libtest-script-run-perl (0.05)
Modified:
branches/upstream/libtest-script-run-perl/current/Changes
branches/upstream/libtest-script-run-perl/current/META.yml
branches/upstream/libtest-script-run-perl/current/lib/Test/Script/Run.pm
branches/upstream/libtest-script-run-perl/current/t/01.run.t
Modified: branches/upstream/libtest-script-run-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-script-run-perl/current/Changes?rev=67334&op=diff
==============================================================================
--- branches/upstream/libtest-script-run-perl/current/Changes (original)
+++ branches/upstream/libtest-script-run-perl/current/Changes Wed Jan 12 23:26:19 2011
@@ -1,4 +1,9 @@
Revision history for Test-Script-Run
+
+0.05 Fri Jan 7 15:17:34 CST 2011
+
+ add '.' to the default bin dirs
+ set exit code to 127 if the script can't be found
0.04 Fri Jun 25 12:01:30 CST 2010
Modified: branches/upstream/libtest-script-run-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-script-run-perl/current/META.yml?rev=67334&op=diff
==============================================================================
--- branches/upstream/libtest-script-run-perl/current/META.yml (original)
+++ branches/upstream/libtest-script-run-perl/current/META.yml Wed Jan 12 23:26:19 2011
@@ -20,4 +20,4 @@
Test::Exception: 0
resources:
license: http://dev.perl.org/licenses/
-version: 0.04
+version: 0.05
Modified: branches/upstream/libtest-script-run-perl/current/lib/Test/Script/Run.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-script-run-perl/current/lib/Test/Script/Run.pm?rev=67334&op=diff
==============================================================================
--- branches/upstream/libtest-script-run-perl/current/lib/Test/Script/Run.pm (original)
+++ branches/upstream/libtest-script-run-perl/current/lib/Test/Script/Run.pm Wed Jan 12 23:26:19 2011
@@ -8,7 +8,7 @@
use File::Basename;
use File::Spec;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
use base 'Exporter';
our @EXPORT =
qw/run_ok run_not_ok run_script run_output_matches run_output_matches_unordered/;
@@ -20,7 +20,7 @@
$last_script_exit_code,
);
-our @BIN_DIRS = ('bin','sbin','script');
+our @BIN_DIRS = ('bin','sbin','script', '.');
=head1 NAME
@@ -29,7 +29,7 @@
=head1 SYNOPSIS
use Test::Script::Run;
- # customized names of bin dirs, default is qw/bin sbin script/;
+ # customized names of bin dirs, default is qw/bin sbin script ./;
@Test::Script::Run::BIN_DIRS = qw/bin/;
run_ok( 'app_name', [ app's args ], 'you_app runs ok' );
my ( $return, $stdout, $stderr ) = run_script( 'app_name', [ app's args ] );
@@ -85,19 +85,26 @@
}
my @cmd = get_perl_cmd($script);
- my $ret = run3 [ @cmd, @$args ], undef, $stdout, $stderr;
- $last_script_exit_code = $? >> 8;
- if ( ref $stdout eq 'SCALAR' ) {
- $last_script_stdout = $$stdout;
- }
-
- if ( ref $stderr eq 'SCALAR' ) {
- $last_script_stderr = $$stderr;
- }
-
- return $return_stdouterr
- ? ( $ret, $last_script_stdout, $last_script_stderr )
- : $ret;
+ if (@cmd) {
+ my $ret = run3 [ @cmd, @$args ], undef, $stdout, $stderr;
+ $last_script_exit_code = $? >> 8;
+ if ( ref $stdout eq 'SCALAR' ) {
+ $last_script_stdout = $$stdout;
+ }
+
+ if ( ref $stderr eq 'SCALAR' ) {
+ $last_script_stderr = $$stderr;
+ }
+
+ return $return_stdouterr
+ ? ( $ret, $last_script_stdout, $last_script_stderr )
+ : $ret;
+ }
+ else {
+ # usually people use 127 to show error about the command can't be found
+ $last_script_exit_code = 127;
+ return;
+ }
}
=head2 run_ok($script, $args, $msg)
@@ -140,7 +147,7 @@
lives_and {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ( $ret, $stdout, $stderr ) = run_script( $script, $args );
- cmp_ok( $? >> 8, $cmp, 0, $msg );
+ cmp_ok( $last_script_exit_code, $cmp, 0, $msg );
};
}
@@ -161,7 +168,7 @@
=head2 get_perl_cmd($script, @ARGS)
Returns a list suitable for passing to C<system>, C<exec>, etc. If you pass
-C<$script> then we will search upwards for a file F<bin/$script>.
+C<$script> then we will search upwards for it in C<@BIN_DIRS>
=cut
@@ -170,13 +177,20 @@
my $base_dir;
if (defined $script) {
- unless ( File::Spec->file_name_is_absolute($script) ) {
+ my $fail = 0;
+ if ( File::Spec->file_name_is_absolute($script) ) {
+ unless ( -f $script ) {
+ warn "couldn't find the script $script";
+ $fail = 1;
+ }
+ }
+ else {
my ( $tmp, $i ) = ( _updir($0), 0 );
my $found;
LOOP:
while ( $i++ < 10 ) {
for my $bin ( @BIN_DIRS ) {
- if ( -e File::Spec->catfile( $tmp, $bin, $script ) ) {
+ if ( -f File::Spec->catfile( $tmp, $bin, $script ) ) {
$script = File::Spec->catfile( $tmp, $bin, $script );
$found = 1;
last LOOP;
@@ -185,8 +199,12 @@
$tmp = _updir($tmp);
}
- warn "couldn't find the script" unless $found;
- }
+ unless ( $found ) {
+ warn "couldn't find the script $script";
+ $fail = 1;
+ }
+ }
+ return if $fail;
}
# We grep out references because of INC-hooks like Jifty::ClassLoader
Modified: branches/upstream/libtest-script-run-perl/current/t/01.run.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-script-run-perl/current/t/01.run.t?rev=67334&op=diff
==============================================================================
--- branches/upstream/libtest-script-run-perl/current/t/01.run.t (original)
+++ branches/upstream/libtest-script-run-perl/current/t/01.run.t Wed Jan 12 23:26:19 2011
@@ -6,7 +6,7 @@
use File::Spec;
run_not_ok( 'not_exist.pl', 'run not exist script');
-ok( last_script_exit_code, 'last exit code is not 0' );
+is( last_script_exit_code, 127, 'last exit code is 127' );
run_ok( 'test.pl', 'run test.pl' );
is( last_script_stdout, "out line 1\nout line 2", 'last stdout' );
More information about the Pkg-perl-cvs-commits
mailing list