Integrate perlio:

[ 14422]
Save $! so that other syscalls don't disturb it before 
we test it.

[ 14421]
More Win32 tuning

[ 14420]
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.

p4raw-link: @14422 on //depot/perlio: b5d2fea7d685aa8937f7ded78f879c6c841bf93a
p4raw-link: @14421 on //depot/perlio: d5b53b20fa4fb4addda7b1ca4ad0ea6095f136b8
p4raw-link: @14420 on //depot/perlio: 9e735501884a3429d67c8ca73d8bc17bf1b673f0

p4raw-id: //depot/perl@14424

4 files changed, 56 insertions, 19 deletions

diff --git a/ext/Socket/socketpair.t b/ext/Socket/socketpair.t
index 639606a3e9..d14ccb44d9 100644
--- a/ext/Socket/socketpair.t
+++ b/ext/Socket/socketpair.t
@@ -9,7 +9,7 @@ BEGIN {
     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 @@ ok (shutdown(LEFT, SHUT_WR), "shutdown left for writing");
   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);
diff --git a/t/op/stat.t b/t/op/stat.t
index 82566a8d1d..dac954acd0 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -49,7 +49,7 @@ SKIP: {
 }
 
 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: {
 
     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 @@ SKIP: {
         # 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: {
     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: {
         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 @@ SKIP: {
 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 @@ unlink $tmpfile or print "# unlink failed: $!\n";
 # bug id 20011101.069
 my @r = \stat(".");
 is(scalar @r, 13,   'stat returns full 13 elements');
-
diff --git a/t/op/taint.t b/t/op/taint.t
index 21cf2fafb7..7c83019e7c 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -919,7 +919,10 @@ ok( $@ =~ /^Modification of a read-only value attempted/,
     test 182, tainted $re3;
 }
 
-
+if ($Is_MSWin32) {
+    print "ok 183 # Skipped: system {} has different semantics\n"; 
+}
+else
 {
     # bug 20010221.005
     local $ENV{PATH} .= $TAINT;
diff --git a/t/op/winsystem.t b/t/op/winsystem.t
index 22dcd8bbfa..a0266da5ef 100644
--- a/t/op/winsystem.t
+++ b/t/op/winsystem.t
@@ -26,6 +26,7 @@ my $exename = "showav";
 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 @@ close $F;
 # 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 @@ if (open(my $EIN, "$cwd/op/${exename}_exe.uu")) {
     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: $!";