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

sartak at bestpractical.com sartak at bestpractical.com
Mon Nov 16 18:55:11 EST 2009


The branch, master has been updated
       via  4c31aabc7973e4cadb45a3a01e49418f9995495e (commit)
      from  bd7ae38ff600cea635682626b71123d66cfbdc2b (commit)

Summary of changes:
 lib/Test/Script/Run.pm |   27 ++++++++++++++++++---------
 1 files changed, 18 insertions(+), 9 deletions(-)

- Log -----------------------------------------------------------------
commit 4c31aabc7973e4cadb45a3a01e49418f9995495e
Author: Shawn M Moore <sartak at gmail.com>
Date:   Mon Nov 16 18:55:04 2009 -0500

    More get_perl_cmd improvements

diff --git a/lib/Test/Script/Run.pm b/lib/Test/Script/Run.pm
index 488fa4c..472b689 100644
--- a/lib/Test/Script/Run.pm
+++ b/lib/Test/Script/Run.pm
@@ -156,21 +156,25 @@ our $RUNCNT;
 
 =head2 get_perl_cmd($script, @ARGS)
 
-Returns a list suitable for passing to C<system>, C<exec>, etc.
+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>.
 
 =cut
 
 sub get_perl_cmd {
     my $script = shift;
     my $base_dir;
-    unless ( File::Spec->file_name_is_absolute($script) ) {
-        my ( $tmp, $i ) = ( _updir($0), 0 );
-        while ( !-d File::Spec->catdir( $tmp, 'bin' ) && $i++ < 10 ) {
-            $tmp = _updir($tmp);
-        }
 
-        $base_dir = File::Spec->catdir( $tmp, 'bin' );
-        die "couldn't find bin dir" unless -d $base_dir;
+    if (defined $script) {
+        unless ( File::Spec->file_name_is_absolute($script) ) {
+            my ( $tmp, $i ) = ( _updir($0), 0 );
+            while ( !-d File::Spec->catdir( $tmp, 'bin' ) && $i++ < 10 ) {
+                $tmp = _updir($tmp);
+            }
+
+            $base_dir = File::Spec->catdir( $tmp, 'bin' );
+            die "couldn't find bin dir" unless -d $base_dir;
+        }
     }
 
     # We grep out references because of INC-hooks like Jifty::ClassLoader
@@ -181,7 +185,12 @@ sub get_perl_cmd {
         push @cmd, '-d:DProf';
         $ENV{'PERL_DPROF_OUT_FILE_NAME'} = 'tmon.out.' . $$ . '.' . $RUNCNT++;
     }
-    push @cmd, $base_dir ? File::Spec->catdir( $base_dir => $script ) : $script;
+
+    if (defined $script) {
+        push @cmd, $base_dir ? File::Spec->catdir( $base_dir => $script ) : $script;
+        push @cmd, @_;
+    }
+
     return @cmd;
 }
 

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



More information about the Bps-public-commit mailing list