diff options
Diffstat (limited to 'cpan')
-rw-r--r-- | cpan/ExtUtils-PL2Bat/lib/ExtUtils/PL2Bat.pm | 4 | ||||
-rw-r--r-- | cpan/ExtUtils-PL2Bat/t/make_executable.t | 85 |
2 files changed, 59 insertions, 30 deletions
diff --git a/cpan/ExtUtils-PL2Bat/lib/ExtUtils/PL2Bat.pm b/cpan/ExtUtils-PL2Bat/lib/ExtUtils/PL2Bat.pm index 054b47f423..4341843ad6 100644 --- a/cpan/ExtUtils-PL2Bat/lib/ExtUtils/PL2Bat.pm +++ b/cpan/ExtUtils-PL2Bat/lib/ExtUtils/PL2Bat.pm @@ -1,5 +1,5 @@ package ExtUtils::PL2Bat; -$ExtUtils::PL2Bat::VERSION = '0.002'; +$ExtUtils::PL2Bat::VERSION = '0.003'; use strict; use warnings; @@ -122,7 +122,7 @@ ExtUtils::PL2Bat - Batch file creation to run perl scripts on Windows =head1 VERSION -version 0.002 +version 0.003 =head1 OVERVIEW diff --git a/cpan/ExtUtils-PL2Bat/t/make_executable.t b/cpan/ExtUtils-PL2Bat/t/make_executable.t index 6e7beb2183..0d75dc1629 100644 --- a/cpan/ExtUtils-PL2Bat/t/make_executable.t +++ b/cpan/ExtUtils-PL2Bat/t/make_executable.t @@ -2,59 +2,88 @@ use strict; use warnings FATAL => 'all'; +use English; use Config; use Test::More; use ExtUtils::PL2Bat; use Cwd qw/cwd/; -plan($^O eq 'MSWin32' ? (tests => 8) : skip_all => 'Only usable on Windows'); +my @test_vals = ( 0, 1, 2, 3, -1, -2, 65535, 65536, 65537, 47, 100, 200, 255, 256, 257, 258, 511, 512, 513, -255, -256, -20012001 ); -my $filename = 'test_exec'; -my @files; +plan($OSNAME eq 'MSWin32' ? ( tests => (($#test_vals+1)*5)+2 ) : ( skip_all => 'Only usable on Windows' )); -open my $out, '>', $filename or die "Couldn't create $filename: $!"; +my $perl_in_fname = 'test_perl_source'; + +open my $out, '>', $perl_in_fname or die qq{Couldn't create source file ("$perl_in_fname"): $!}; print $out "#! perl -w\nexit \$ARGV[0];\n"; close $out; -pl2bat(in => $filename); +pl2bat(in => $perl_in_fname); + +my $batch_out_fname = $perl_in_fname.'.bat'; + +ok (-e "$batch_out_fname", qq{Executable file exists ("$batch_out_fname")}); + +my $int_max_8bit = 2**8; +my $int_max_16bit = 2**16; my $path_with_cwd = construct_test_PATH(); -foreach my $i (42, 51, 0) { - local $ENV{PATH} = $path_with_cwd; - my $ret = system $filename, $i; - is $ret & 0xff, 0, 'test_exec executed successfully'; - is $ret >> 8, $i, "test_exec $i return value ok"; -} +foreach my $input_val ( @test_vals ) { + local $ENV{PATH} = $path_with_cwd; + my $qx_output = q//; + my $qx_retval = 0; + my $error_level = 0; + my $status = q//; + my $success = 1; + + $success &&= eval { $qx_output = qx{"$batch_out_fname" $input_val}; $qx_retval = $CHILD_ERROR; $qx_retval != -1; }; + $qx_retval = ( $qx_retval > 0 ) ? ( $qx_retval >> 8 ) : $qx_retval; -push @files, grep { -f } map { $filename.$_ } split / $Config{path_sep} /x, $ENV{PATHEXT} || ''; -is scalar(@files), 1, "Executable file exists"; + $success &&= eval { $error_level = qx{"$batch_out_fname" $input_val & call echo ^%ERRORLEVEL^%}; 1; }; + $error_level =~ s/\r?\n$//msx; + + $success &&= eval { $status = qx{"$batch_out_fname" $input_val && (echo PROCESS_SUCCESS) || (echo PROCESS_FAILURE)}; 1; }; + $status =~ s/\r?\n$//msx; + + # (for qx/.../) post-call status values ($CHILD_ERROR) can be [ 0 ... 255 ]; values outside that range will be returned as `value % 256` + my $expected_qx_retval = ($input_val % $int_max_8bit); + + # `exit $value` will set ERRORLEVEL to $value for values of [ -1, 0 ... 65535 ]; values outside that range will set ERRORLEVEL to `$value % 65536` + my $expected_error_level = ($input_val == -1) ? -1 : ($input_val % $int_max_16bit); + + is $success, 1, qq{`"$batch_out_fname" $input_val` executed successfully}; + is $qx_output, q//, qq{qx/"$batch_out_fname" $input_val/ returns expected empty output}; # assure no extraneous output from BAT wrap + is $qx_retval, $expected_qx_retval, qq{qx/"$batch_out_fname" $input_val/ returns expected $CHILD_ERROR ($expected_qx_retval)}; + is $error_level, $expected_error_level, qq{"$batch_out_fname": `exit $input_val` set expected ERRORLEVEL ($expected_error_level)}; + is $status, (($input_val % $int_max_16bit) == 0) ? 'PROCESS_SUCCESS' : 'PROCESS_FAILURE', qq{`"$batch_out_fname" $input_val` process exit ($status) is correct}; +} -unlink $filename, @files; +unlink $perl_in_fname, $batch_out_fname; # the test needs CWD in PATH to check the created .bat files, but under win2k # PATH must not be too long. so to keep any win2k smokers happy, we construct # a new PATH that contains the dirs which hold cmd.exe, perl.exe, and CWD sub construct_test_PATH { - my $perl_path = $^X; - my $cmd_path = $ENV{ComSpec} || `where cmd`; # where doesn't seem to work on all windows versions - $_ =~ s/[\\\/][^\\\/]+$// for $perl_path, $cmd_path; # strip executable names + my $perl_path = $^X; + my $cmd_path = $ENV{ComSpec} || `where cmd`; # where doesn't seem to work on all windows versions + $_ =~ s/[\\\/][^\\\/]+$// for $perl_path, $cmd_path; # strip executable names - my @path_fallbacks = grep /\Q$ENV{SystemRoot}\E|system32|winnt|windows/i, split $Config{path_sep}, $ENV{PATH}; + my @path_fallbacks = grep /\Q$ENV{SystemRoot}\E|system32|winnt|windows/i, split $Config{path_sep}, $ENV{PATH}; - my $path_with_cwd = join $Config{path_sep}, @path_fallbacks, $cmd_path, $perl_path, cwd(); + my $path_with_cwd = join $Config{path_sep}, @path_fallbacks, $cmd_path, $perl_path, cwd(); - my ($perl) = ( $^X =~ /[\\\/]([^\\]+)$/ ); # in case the perl executable name differs - note "using perl executable name: $perl"; + my ($perl) = ( $^X =~ /[\\\/]([^\\]+)$/ ); # in case the perl executable name differs + note "using perl executable name: $perl"; - local $ENV{PATH} = $path_with_cwd; - my $test_out = `$perl -e 1 2>&1`; - is $test_out, "", "perl execution with temp path works" - or diag "make_executable.t tmp path: $path_with_cwd"; - diag "make_executable.t PATH likely did not contain cmd.exe" - if !defined $test_out; + local $ENV{PATH} = $path_with_cwd; + my $test_out = `$perl -e 1 2>&1`; + is $test_out, "", "perl execution with temp path works" + or diag "make_executable.t tmp path: $path_with_cwd"; + diag "make_executable.t PATH likely did not contain cmd.exe" + if !defined $test_out; - return $path_with_cwd; + return $path_with_cwd; } |