[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