| Subject: | Win32 related errors in Test-Harness-2.30 |
Hi,
More Win32 bugs. Sorry :-(
The first is if you have a path in @INC that ends in a backslash. When the test script runs under taint the path will be quoted which will result in the trailing quote escaping the quote which will result in the whole command line being taken as a single -I, and then perl hangs waiting for you type in your code via STDIN :-)
The second is that code that builds the switches can inadverdantly produce a command line where two quoted switches are immediately adjacent to each other without any intervening whitespace. This causes problems as well.
Third is that it does an improper test to determine if the box is Win32.
Attached is a patch that resolves the problems.
I also patched the "$control is an accidental static" problem in Harness pm that I noticed was bug reported.
Cheers,
yves
Summary of my perl5 (revision 5 version 6 subversion 1) configuration:
Platform:
osname=MSWin32, osvers=4.0, archname=MSWin32-x86-multi-thread
uname=''
config_args='undef'
hint=recommended, useposix=true, d_sigaction=undef
usethreads=undef use5005threads=undef useithreads=define usemultiplicity=define
useperlio=undef d_sfio=undef uselargefiles=undef usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
Compiler:
cc='cl', ccflags ='-nologo -O1 -MD -Zi -DNDEBUG -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DPERL_MSVCRT_READFIX',
optimize='-O1 -MD -Zi -DNDEBUG',
cppflags='-DWIN32'
ccversion='', gccversion='', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
alignbytes=8, usemymalloc=n, prototype=define
Linker and Libraries:
ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf -libpath:"E:\ASPerl635\lib\CORE" -machine:x86'
libpth="E:\ASPerl635\lib\CORE"
libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib
perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib
libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl56.lib
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf -libpath:"E:\ASPerl635\lib\CORE" -machine:x86'
Characteristics of this binary (from libperl):
Compile-time options: MULTIPLICITY USE_ITHREADS PERL_IMPLICIT_CONTEXT PERL_IMPLICIT_SYS
Locally applied patches:
ActivePerl Build 635
Built under MSWin32
Compiled at Feb 4 2003 15:34:21
%ENV:
PERL5LIB="D:\perl\devlib\"
@INC:
D:\perl\devlib\
E:/ASPerl635/lib
E:/ASPerl635/site/lib
.
diff -wurd Test-Harness-2.30/lib/Test/Harness/Straps.pm Test-Harness-2.30-patched/lib/Test/Harness/Straps.pm
--- Test-Harness-2.30/lib/Test/Harness/Straps.pm 2003-08-15 03:29:23.000000000 +0200
+++ Test-Harness-2.30-patched/lib/Test/Harness/Straps.pm 2003-09-20 23:09:38.039488000 +0200
@@ -90,7 +90,7 @@
my($self) = shift;
$self->{_is_vms} = $^O eq 'VMS';
- $self->{_is_win32} = $^O eq 'Win32';
+ $self->{_is_win32} = $^O =~/^(MSWin32|dos)$/;
}
=head1 Analysis
@@ -267,6 +267,7 @@
my $switches = $self->_switches($file);
+ #print STDERR "# $cmd $switches $file\nC:$cmd\nS:$switches\nF:$file\n";
# *sigh* this breaks under taint, but open -| is unportable.
unless( open(FILE, "$cmd $switches $file|") ) {
print "can't run $file. $!\n";
@@ -313,23 +314,22 @@
local *TEST;
open(TEST, $file) or print "can't open $file. $!\n";
my $first = <TEST>;
- my $s = $Test::Harness::Switches || '';
- $s .= " $ENV{'HARNESS_PERL_SWITCHES'}"
- if exists $ENV{'HARNESS_PERL_SWITCHES'};
+
+ my @switches=grep { $_ } $Test::Harness::Switches,$ENV{'HARNESS_PERL_SWITCHES'};
if ($first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/) {
# When taint mode is on, PERL5LIB is ignored. So we need to put
# all that on the command line as -Is.
- $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} $self->_filtered_INC;
+ push @switches, qq["-$1"], map {qq["-I$_"]} $self->_filtered_INC;
}
elsif ($^O eq 'MacOS') {
# MacPerl's putenv is broken, so it will not see PERL5LIB.
- $s .= join " ", map {qq["-I$_"]} $self->_filtered_INC;
+ push @switches, map {qq["-I$_"]} $self->_filtered_INC;
}
close(TEST) or print "can't close $file. $!\n";
- return $s;
+ return join " ", @switches;
}
@@ -356,6 +356,7 @@
Shortens C<@INC> by removing redundant and unnecessary entries.
Necessary for OSes with limited command line lengths, like VMS.
+Also cleans off trailing backslashes on Win32.
=cut
@@ -363,14 +364,19 @@
my($self, @inc) = @_;
@inc = @INC unless @inc;
+ if( $self->{_is_vms} ) {
# VMS has a 255-byte limit on the length of %ENV entries, so
# toss the ones that involve perl_root, the install location
# for VMS
- if( $self->{_is_vms} ) {
@inc = grep !/perl_root/i, @inc;
+ } elsif ($self->{_is_win32}) {
+ # lose any trailing "\" on the paths on win32.
+ s/[\\\/]+$// foreach @inc;
}
- return @inc;
+ # and return the list with any dupes removed.
+ my %dupe;
+ return grep !$dupe{$_}++,@inc;
}
@@ -501,8 +507,11 @@
# We pulverize the line down into pieces in three parts.
if( my($not, $num, $extra) = $line =~ /$Report_Re/ox ) {
- my($name, $control) = split /(?:[^\\]|^)#/, $extra if $extra;
- my($type, $reason) = $control =~ /^\s*(\S+)(?:\s+(.*))?$/ if $control;
+ my ($name, $control) = $extra ? split(/(?:[^\\]|^)#/, $extra)
+ : ();
+ my ($type, $reason) = $control ? $control =~ /^\s*(\S+)(?:\s+(.*))?$/
+ : ();
+
$test->{number} = $num;
$test->{ok} = $not ? 0 : 1;
diff -wurd Test-Harness-2.30/t/test-harness.t Test-Harness-2.30-patched/t/test-harness.t
--- Test-Harness-2.30/t/test-harness.t 2003-07-13 07:50:29.000000000 +0200
+++ Test-Harness-2.30-patched/t/test-harness.t 2003-09-20 23:12:18.590348800 +0200
@@ -478,12 +478,15 @@
tie *NULL, 'My::Dev::Null' or die $!;
-while (my($test, $expect) = each %samples) {
+foreach my $test (sort keys %samples) {
+ my $expect=$samples{$test};
+
# _run_all_tests() runs the tests but skips the formatting.
my($totals, $failed);
my $warning = '';
my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
+ print STDERR "# $test\n" if $ENV{TEST_VERBOSE};
eval {
select NULL; # _run_all_tests() isn't as quiet as it should be.
local $SIG{__WARN__} = sub { $warning .= join '', @_; };
@@ -531,3 +534,4 @@
is( $warning, '' );
}
}
+