Author: jkeenan
Date: Fri Nov 28 07:03:32 2008
New Revision: 33313
Modified:
branches/testparrottest/lib/Parrot/Test.pm
branches/testparrottest/t/perl/Parrot_Test.t
Log:
Refactor some code from inside Parrot::Test::run_command() into internal subs,
then add tests for those subs in t/perl/Parrot_Test.t.
Modified: branches/testparrottest/lib/Parrot/Test.pm
==============================================================================
--- branches/testparrottest/lib/Parrot/Test.pm (original)
+++ branches/testparrottest/lib/Parrot/Test.pm Fri Nov 28 07:03:32 2008
@@ -303,37 +303,11 @@
sub run_command {
my ( $command, %options ) = @_;
- # To run the command in a different directory.
- my $chdir = delete $options{CD};
-
- while ( my ( $key, $value ) = each %options ) {
- $key =~ m/^STD(OUT|ERR)$/
- or die "I don't know how to redirect '$key' yet!";
- my $strvalue = "$value"; # filehandle `eq' string will fail
- $value = File::Spec->devnull() # on older perls, so stringify it
- if $strvalue eq '/dev/null';
- }
-
- my $out = $options{'STDOUT'} || '';
- my $err = $options{'STDERR'} || '';
+ my ( $out, $err, $chdir ) = _handle_test_options( \%options );;
- local $ENV;
+# local $ENV;
if ($PConfig{parrot_is_shared}) {
- my $blib_path = File::Spec->catfile( $PConfig{build_dir}, 'blib',
'lib' );
- if ($^O eq 'cygwin') {
- $ENV{PATH} = $blib_path . ':' . $ENV{PATH};
- }
- elsif ($^O eq 'MSWin32') {
- $ENV{PATH} = $blib_path . ';' . $ENV{PATH};
- }
- else {
- $ENV{LD_RUN_PATH} = $blib_path;
- }
- }
-
- ## File::Temp overloads 'eq' here, so we need the quotes. RT #58840
- if ( $out and $err and "$out" eq "$err" ) {
- $err = '&STDOUT';
+ _handle_blib_path();
}
local *OLDOUT if $out; ## no critic
Variables::ProhibitConditionalDeclarations
@@ -357,11 +331,7 @@
# If $command isn't already an arrayref (because of a multi-command
# test), make it so now so the code below can treat everybody the
# same.
- $command = [$command] unless ( ref $command );
-
- if ( defined $ENV{VALGRIND} ) {
- $_ = "$ENV{VALGRIND} $_" for (@$command);
- }
+ $command = _handle_command( $command );
my $orig_dir;
if ($chdir) {
@@ -382,7 +352,7 @@
chdir $orig_dir;
}
- my $exit_code = $?;
+ my $exit_message = _prepare_exit_message();
close STDOUT or die "Can't close stdout" if $out;
close STDERR or die "Can't close stderr" if $err;
@@ -390,11 +360,7 @@
open STDOUT, ">&", \*OLDOUT or die "Can't restore stdout" if $out;
open STDERR, ">&", \*OLDERR or die "Can't restore stderr" if $err;
- return (
- ( $exit_code < 0 ) ? $exit_code
- : ( $exit_code & 0xFF ) ? "[SIGNAL $exit_code]"
- : ( $? >> 8 )
- );
+ return $exit_message;
}
sub per_test {
@@ -687,11 +653,67 @@
}
}
+sub _handle_test_options {
+ my $options = shift;
+ # To run the command in a different directory.
+ my $chdir = delete $options->{CD} || '';
+
+ while ( my ( $key, $value ) = each %{ $options } ) {
+ $key =~ m/^STD(OUT|ERR)$/
+ or die "I don't know how to redirect '$key' yet!";
+ my $strvalue = "$value"; # filehandle `eq' string will fail
+ $value = File::Spec->devnull() # on older perls, so stringify it
+ if $strvalue eq '/dev/null';
+ }
+
+ my $out = $options->{'STDOUT'} || '';
+ my $err = $options->{'STDERR'} || '';
+ ## File::Temp overloads 'eq' here, so we need the quotes. RT #58840
+ if ( $out and $err and "$out" eq "$err" ) {
+ $err = '&STDOUT';
+ }
+ return ( $out, $err, $chdir );
+}
+
+sub _handle_blib_path {
+ my $blib_path =
+ File::Spec->catfile( $PConfig{build_dir}, 'blib', 'lib' );
+ if ($^O eq 'cygwin') {
+ $ENV{PATH} = $blib_path . ':' . $ENV{PATH};
+ }
+ elsif ($^O eq 'MSWin32') {
+ $ENV{PATH} = $blib_path . ';' . $ENV{PATH};
+ }
+ else {
+ $ENV{LD_RUN_PATH} = $blib_path;
+ }
+}
+
+sub _handle_command {
+ my $command = shift;
+ $command = [$command] unless ( ref $command );
+
+ if ( defined $ENV{VALGRIND} ) {
+ $_ = "$ENV{VALGRIND} $_" for (@$command);
+ }
+ return $command;
+}
+
+sub _prepare_exit_message {
+ my $exit_code = $?;
+ return (
+ ( $exit_code < 0 ) ? $exit_code
+ : ( $exit_code & 0xFF ) ? "[SIGNAL $exit_code]"
+ : ( $? >> 8 )
+ );
+}
+
sub _generate_test_functions {
my $package = 'Parrot::Test';
my $path_to_parrot = path_to_parrot();
- my $parrot = File::Spec->join( File::Spec->curdir(), 'parrot' .
$PConfig{exe} );
+ my $parrot = File::Spec->join( File::Spec->curdir(),
+ 'parrot' . $PConfig{exe} );
my $pirc = File::Spec->join( File::Spec->curdir(),
qw( compilers pirc ), "pirc$PConfig{exe}" );
Modified: branches/testparrottest/t/perl/Parrot_Test.t
==============================================================================
--- branches/testparrottest/t/perl/Parrot_Test.t (original)
+++ branches/testparrottest/t/perl/Parrot_Test.t Fri Nov 28 07:03:32 2008
@@ -19,6 +19,10 @@
use strict;
use warnings;
use Test::More;
+use File::Spec;
+use lib qw( lib );
+use Parrot::Config;
+use IO::CaptureOutput qw| capture |;
BEGIN {
eval "use Test::Builder::Tester;";
@@ -26,7 +30,7 @@
plan( skip_all => "Test::Builder::Tester not installed\n" );
exit 0;
}
- plan( tests => 66 );
+ plan( tests => 94 );
}
use lib qw( . lib ../lib ../../lib );
@@ -316,6 +320,149 @@
test_test($desc);
}
+##### Tests for Parrot::Test internal subroutines #####
+
+# _handle_test_options()
+my ( $out, $chdir );
+( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( {
+ STDOUT => '/tmp/captureSTDOUT',
+ STDERR => '/tmp/captureSTDERR',
+ CD => '/tmp',
+} );
+is($out, '/tmp/captureSTDOUT', "Got expected value for STDOUT");
+is($err, '/tmp/captureSTDERR', "Got expected value for STDERR");
+is($chdir, '/tmp', "Got expected value for working directory");
+
+( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( {
+ STDOUT => '/tmp/captureSTDOUT',
+ STDERR => '',
+ CD => '/tmp',
+} );
+is($out, '/tmp/captureSTDOUT', "Got expected value for STDOUT");
+is($err, '', "Got expected value for STDERR");
+is($chdir, '/tmp', "Got expected value for working directory");
+
+( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( {
+ STDOUT => '',
+ STDERR => '',
+ CD => '',
+} );
+is($out, '', "Got expected value for STDOUT");
+is($err, '', "Got expected value for STDERR");
+is($chdir, '', "Got expected value for working directory");
+
+eval {
+ ( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( {
+ STDJ => '',
+ STDERR => '',
+ CD => '',
+ } );
+};
+like($@, qr/I don't know how to redirect 'STDJ' yet!/,
+ "Got expected error message for bad option");
+
+my $dn = File::Spec->devnull();
+( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( {
+ STDOUT => '',
+ STDERR => '/dev/null',
+ CD => '',
+} );
+is($out, '', "Got expected value for STDOUT");
+is($err, $dn, "Got expected value for STDERR using /dev/null");
+is($chdir, '', "Got expected value for working directory");
+
+( $out, $err, $chdir ) = Parrot::Test::_handle_test_options( {
+ STDOUT => '/tmp/foobar',
+ STDERR => '/tmp/foobar',
+ CD => '',
+} );
+is($out, '/tmp/foobar', "Got expected value for STDOUT");
+is($err, '&STDOUT', "Got expected value for STDERR when same as STDOUT");
+is($chdir, '', "Got expected value for working directory");
+
+{
+ my $oldpath = $ENV{PATH};
+ my $oldldrunpath = $ENV{LD_RUN_PATH};
+ local $PConfig{build_dir} = 'foobar';
+ my $blib_path = File::Spec->catfile( $PConfig{build_dir}, 'blib', 'lib' );
+ {
+ local $^O = 'cygwin';
+ Parrot::Test::_handle_blib_path();
+ is( $ENV{PATH}, $blib_path . ':' . $oldpath,
+ "\$ENV{PATH} reset as expected for $^O");
+ $ENV{PATH} = $oldpath;
+ }
+ {
+ local $^O = 'MSWin32';
+ Parrot::Test::_handle_blib_path();
+ is( $ENV{PATH}, $blib_path . ';' . $oldpath,
+ "\$ENV{PATH} reset as expected for $^O");
+ $ENV{PATH} = $oldpath;
+ }
+ {
+ local $^O = 'not_cygwin_not_MSWin32';
+ Parrot::Test::_handle_blib_path();
+ is( $ENV{LD_RUN_PATH}, $blib_path,
+ "\$ENV{LD_RUN_PATH} reset as expected for $^O");
+ $ENV{LD_RUN_PATH} = $oldldrunpath;
+ }
+}
+
+my $command_orig;
+$command_orig = 'ls';
+is_deeply( Parrot::Test::_handle_command($command_orig), [ qw( ls ) ],
+ "Scalar command transformed into array ref as expected");
+$command_orig = [ qw( ls -l ) ];
+is( Parrot::Test::_handle_command($command_orig), $command_orig,
+ "Array ref holding multiple commands unchanged as expected");
+
+{
+ my $oldvalgrind = $ENV{VALGRIND};
+ $command_orig = 'ls';
+ my $foo = 'foobar';
+ local $ENV{VALGRIND} = $foo;
+ my $ret = Parrot::Test::_handle_command($command_orig);
+ is( $ret->[0], "$foo $command_orig",
+ "Got expected value in Valgrind environment");
+ $ENV{VALGRIND} = $oldvalgrind;
+}
+
+{
+ local $? = -1;
+ my $exit_message = Parrot::Test::_prepare_exit_message();
+ is( $exit_message, -1, "Got expected exit message" );
+}
+
+{
+ local $? = 0;
+ my $exit_message = Parrot::Test::_prepare_exit_message();
+ is( $exit_message, 0, "Got expected exit message" );
+}
+
+{
+ local $? = 1;
+ my $exit_message = Parrot::Test::_prepare_exit_message();
+ is( $exit_message, q{[SIGNAL 1]}, "Got expected exit message" );
+}
+
+{
+ local $? = 255;
+ my $exit_message = Parrot::Test::_prepare_exit_message();
+ is( $exit_message, q{[SIGNAL 255]}, "Got expected exit message" );
+}
+
+{
+ local $? = 256;
+ my $exit_message = Parrot::Test::_prepare_exit_message();
+ is( $exit_message, 1, "Got expected exit message" );
+}
+
+{
+ local $? = 512;
+ my $exit_message = Parrot::Test::_prepare_exit_message();
+ is( $exit_message, 2, "Got expected exit message" );
+}
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
