[Bps-public-commit] Test-Script-Run branch, master, updated. eca69c3795c38e0c8caef30bd5922fbbcc4df36f

? sunnavy sunnavy at bestpractical.com
Fri Jan 7 02:25:47 EST 2011


The branch, master has been updated
       via  eca69c3795c38e0c8caef30bd5922fbbcc4df36f (commit)
       via  1dff25e592619aad29ce21cb90f350c69ca2788b (commit)
       via  fae1638bc5914dc88dbfe6c2fb31eed830b24a2d (commit)
       via  9a6c065089c467ed1971ff0d28430cb5e12a6984 (commit)
       via  adb53136a9f94cc0d11101fd1ec8c35169391387 (commit)
      from  987f809ec7701c55a1d49252f88699c841bc2cab (commit)

Summary of changes:
 Changes                |    5 ++++
 META.yml               |    2 +-
 lib/Test/Script/Run.pm |   56 +++++++++++++++++++++++++++++++----------------
 t/01.run.t             |    2 +-
 4 files changed, 44 insertions(+), 21 deletions(-)

- Log -----------------------------------------------------------------
commit adb53136a9f94cc0d11101fd1ec8c35169391387
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Fri Jan 7 15:05:33 2011 +0800

    we should make it fail if the script can not be found

diff --git a/lib/Test/Script/Run.pm b/lib/Test/Script/Run.pm
index 9198d9d..3f54226 100644
--- a/lib/Test/Script/Run.pm
+++ b/lib/Test/Script/Run.pm
@@ -85,19 +85,26 @@ sub run_script {
     }
     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 (@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;
-    }
+        if ( ref $stderr eq 'SCALAR' ) {
+            $last_script_stderr = $$stderr;
+        }
 
-    return $return_stdouterr
-      ? ( $ret, $last_script_stdout, $last_script_stderr )
-      : $ret;
+        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 @@ sub _run_ok {
     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 @@ our $RUNCNT;
 =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 @@ sub get_perl_cmd {
     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 @@ LOOP:
                 $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

commit 9a6c065089c467ed1971ff0d28430cb5e12a6984
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Fri Jan 7 15:13:20 2011 +0800

    add . to default bin dirs

diff --git a/lib/Test/Script/Run.pm b/lib/Test/Script/Run.pm
index 3f54226..ed0f1d3 100644
--- a/lib/Test/Script/Run.pm
+++ b/lib/Test/Script/Run.pm
@@ -20,7 +20,7 @@ my (
     $last_script_exit_code,
 );
 
-our @BIN_DIRS = ('bin','sbin','script');
+our @BIN_DIRS = ('bin','sbin','script', '.');
 
 =head1 NAME
 
@@ -29,7 +29,7 @@ Test::Script::Run - test the script with run
 =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 ] );

commit fae1638bc5914dc88dbfe6c2fb31eed830b24a2d
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Fri Jan 7 15:20:09 2011 +0800

    update 0.05 changes

diff --git a/Changes b/Changes
index abc4117..6634062 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,10 @@
 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
 
     allow customization of bin dir names.

commit 1dff25e592619aad29ce21cb90f350c69ca2788b
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Fri Jan 7 15:22:14 2011 +0800

    test the exit code if the script does not exists

diff --git a/t/01.run.t b/t/01.run.t
index b1a4abf..dd1a21a 100644
--- a/t/01.run.t
+++ b/t/01.run.t
@@ -6,7 +6,7 @@ use Test::Script::Run ':all';
 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' );

commit eca69c3795c38e0c8caef30bd5922fbbcc4df36f
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Fri Jan 7 15:25:11 2011 +0800

    bump to 0.06

diff --git a/META.yml b/META.yml
index e825051..e13a627 100644
--- a/META.yml
+++ b/META.yml
@@ -20,4 +20,4 @@ requires:
   Test::Exception: 0
 resources:
   license: http://dev.perl.org/licenses/
-version: 0.05
+version: 0.06
diff --git a/lib/Test/Script/Run.pm b/lib/Test/Script/Run.pm
index ed0f1d3..e993bd1 100644
--- a/lib/Test/Script/Run.pm
+++ b/lib/Test/Script/Run.pm
@@ -8,7 +8,7 @@ use IPC::Run3;
 use File::Basename;
 use File::Spec;
 
-our $VERSION = '0.05';
+our $VERSION = '0.06';
 use base 'Exporter';
 our @EXPORT =
   qw/run_ok run_not_ok run_script run_output_matches run_output_matches_unordered/;

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list