Change 14424 by jhi@alpha on 2002/01/25 22:10:11
Integrate perlio;
Fix winsystem.t's attempt to build showav.exe to work
with gcc (which writes a.exe unless told with -o ).
Also put in a few more fail-safes to check .exe got
built somehow.
More Win32 tuning
Save $! so that other syscalls don't disturb it before
we test it.
Affected files ...
.... //depot/perl/ext/Socket/socketpair.t#11 integrate
.... //depot/perl/t/op/stat.t#56 integrate
.... //depot/perl/t/op/taint.t#42 integrate
.... //depot/perl/t/op/winsystem.t#2 integrate
Differences ...
==== //depot/perl/ext/Socket/socketpair.t#11 (text) ====
Index: perl/ext/Socket/socketpair.t
--- perl/ext/Socket/socketpair.t.~1~ Fri Jan 25 15:15:05 2002
+++ perl/ext/Socket/socketpair.t Fri Jan 25 15:15:05 2002
@@ -9,7 +9,7 @@
require Config; import Config;
$can_fork = $Config{d_fork} || ($^O eq 'MSWin32' && $Config{useithreads});
- if ($^O eq "hpux" or $Config{'extensions'} !~ /\bSocket\b/ &&
+ if ($^O eq "hpux" or $Config{'extensions'} !~ /\bSocket\b/ &&
!(($^O eq 'VMS') && $Config{d_socket})) {
print "1..0\n";
exit 0;
@@ -110,18 +110,25 @@
alarm 60;
}
+my $err = $!;
$SIG{PIPE} = 'IGNORE';
{
local $SIG{ALRM}
= sub { warn "syswrite to left didn't fail within 3 seconds" };
alarm 3;
- is (syswrite (LEFT, "void"), undef, "syswrite to shutdown left should fail");
+ # Split the system call from the is() - is() does IO so
+ # (say) a flush may do a seek which on a pipe may disturb errno
+ my $ans = syswrite (LEFT, "void");
+ $err = $!;
+ is ($ans, undef, "syswrite to shutdown left should fail");
alarm 60;
}
{
- # This may need skipping on some OSes
+ # This may need skipping on some OSes - restoring value saved above
+ # should help
+ $! = $err;
ok (($!{EPIPE} or $!{ESHUTDOWN}), '$! should be EPIPE or ESHUTDOWN')
- or printf "\$\!=%d(%s)\n", $!, $!;
+ or printf "\$\!=%d(%s)\n", $err, $err;
}
my @gripping = (chr 255, chr 127);
==== //depot/perl/t/op/stat.t#56 (xtext) ====
Index: perl/t/op/stat.t
--- perl/t/op/stat.t.~1~ Fri Jan 25 15:15:05 2002
+++ perl/t/op/stat.t Fri Jan 25 15:15:05 2002
@@ -49,7 +49,7 @@
}
SKIP: {
- skip "mtime and ctime not reliable", 2
+ skip "mtime and ctime not reliable", 2
if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos;
ok( $mtime, 'mtime' );
@@ -88,19 +88,23 @@
SKIP: {
my $cwd = File::Spec->rel2abs($Curdir);
- skip "Solaris tmpfs has different mtime/ctime link semantics", 2
- if $Is_Solaris and $cwd =~ m#^/tmp# and
+ skip "Solaris tmpfs has different mtime/ctime link semantics", 2
+ if $Is_Solaris and $cwd =~ m#^/tmp# and
$mtime && $mtime == $ctime;
skip "AFS has different mtime/ctime link semantics", 2
if $cwd =~ m#$Config{'afsroot'}/#;
skip "AmigaOS has different mtime/ctime link semantics", 2
if $Is_Amiga;
-
+ # Win32 could pass $mtime test but as FAT and NTFS have
+ # no ctime concept $ctime is ALWAYS == $mtime
+ # expect netware to be the same ...
+ skip "No ctime concept on this OS", 2
+ if $Is_MSWin32;
if( !ok($mtime, 'hard link mtime') ||
!isnt($mtime, $ctime, 'hard link ctime != mtime') ) {
print <<DIAG;
-# Check if you are on a tmpfs of some sort. Building in /tmp sometimes
-# has this problem. Also building on the ClearCase VOBS filesystem may
+# Check if you are on a tmpfs of some sort. Building in /tmp sometimes
+# has this problem. Also building on the ClearCase VOBS filesystem may
# cause this failure.
DIAG
}
@@ -133,7 +137,7 @@
# Going to try to switch away from root. Might not work.
my $olduid = $>;
eval { $> = 1; };
- skip "Can't test -r or -w meaningfully if you're superuser", 2
+ skip "Can't test -r or -w meaningfully if you're superuser", 2
if $> == 0;
SKIP: {
@@ -199,7 +203,7 @@
skip "/dev isn't available to test against", 3
unless -d '/dev' && -r '/dev' && -x '/dev';
- my $LS = $Config{d_readlink} ? "ls -lL" : "ls -l";
+ my $LS = $Config{d_readlink} ? "ls -lL" : "ls -l";
my $CMD = "$LS /dev 2>/dev/null";
my $DEV = qx($CMD);
@@ -283,7 +287,7 @@
skip "Test uses unixisms", 2 if $Is_MSWin32 || $Is_NetWare;
skip "No TTY to test -t with", 2 unless -e $TTY;
- open(TTY, $TTY) ||
+ open(TTY, $TTY) ||
warn "Can't open $TTY--run t/TEST outside of make.\n";
ok(-t TTY, '-t');
ok(-c TTY, 'tty is -c');
@@ -300,6 +304,7 @@
my $Null = File::Spec->devnull;
SKIP: {
skip "No null device to test with", 1 unless -e $Null;
+ skip "We know Win32 thinks '$Null' is a TTY", 1 if $Is_MSWin32;
open(NULL, $Null) or DIE("Can't open $Null: $!");
ok(! -t NULL, 'null device is not a TTY');
@@ -368,4 +373,3 @@
# bug id 20011101.069
my @r = \stat(".");
is(scalar @r, 13, 'stat returns full 13 elements');
-
==== //depot/perl/t/op/taint.t#42 (xtext) ====
Index: perl/t/op/taint.t
--- perl/t/op/taint.t.~1~ Fri Jan 25 15:15:05 2002
+++ perl/t/op/taint.t Fri Jan 25 15:15:05 2002
@@ -919,7 +919,10 @@
test 182, tainted $re3;
}
-
+if ($Is_MSWin32) {
+ print "ok 183 # Skipped: system {} has different semantics\n";
+}
+else
{
# bug 20010221.005
local $ENV{PATH} .= $TAINT;
==== //depot/perl/t/op/winsystem.t#2 (text) ====
Index: perl/t/op/winsystem.t
--- perl/t/op/winsystem.t.~1~ Fri Jan 25 15:15:05 2002
+++ perl/t/op/winsystem.t Fri Jan 25 15:15:05 2002
@@ -26,6 +26,7 @@
my $plxname = "showargv";
rmtree($testdir);
mkdir($testdir);
+die "Could not create '$testdir':$!" unless -d $testdir;
open(my $F, ">$testdir/$exename.c")
or die "Can't create $testdir/$exename.c: $!";
@@ -75,8 +76,8 @@
# build the executable
chdir($testdir);
END {
- chdir($cwd);
- rmtree($testdir);
+# chdir($cwd);
+# rmtree($testdir);
}
if (open(my $EIN, "$cwd/op/${exename}_exe.uu")) {
print "# Unpacking $exename.exe\n";
@@ -92,15 +93,37 @@
close $EOUT;
}
else {
- print "# Compiling $exename.c\n";
- if (system("$Config{cc} $Config{ccflags} $exename.c 2>&1 >nul") != 0) {
+ my $minus_o = '';
+ if ($Config{cc} eq 'gcc')
+ {
+ $minus_o = "-o $exename.exe";
+ }
+ print "# Compiling $exename.c\n# $Config{cc} $Config{ccflags} $exename.c\n";
+ if (system("$Config{cc} $Config{ccflags} $minus_o $exename.c >log 2>&1") != 0) {
print "# Could not compile $exename.c, status $?\n"
."# Where is your C compiler?\n"
."1..0 # skipped: can't build test executable\n";
+ exit(0);
}
+ unless (-f "$exename.exe") {
+ if (open(LOG,'<log'))
+ {
+ while(<LOG>) {
+ print "# ",$_;
+ }
+ }
+ else {
+ warn "Cannot open log (in $testdir):$!";
+ }
+ }
}
copy("$plxname.bat","$plxname.cmd");
chdir($cwd);
+unless (-x "$testdir/$exename.exe") {
+ print "# Could not build $exename.exe\n"
+ ."1..0 # skipped: can't build test executable\n";
+ exit(0);
+}
open my $T, "$^X -I../lib -w op/system_tests |"
or die "Can't spawn op/system_tests: $!";
End of Patch.
