Fix File::Copy with hard links on Windows.

Subject: [PATCH] Re: perl @ 21830
Date: Wed, 03 Dec 2003 10:53:02 +0000
Message-ID: <3FCDC08E.7080800@uk.radan.com>

and
Date: Thu, 04 Dec 2003 11:02:22 +0000
Message-ID: <3FCF143E.1040905@uk.radan.com>

p4raw-id: //depot/perl@21841

diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index a01192b..f5b22e2 100644 (file)
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -78,7 +78,7 @@ sub copy {
     }
 
     if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
-       !($^O eq 'Win32' || $^O eq 'os2' || $^O eq 'vms')) {
+       !($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'vms')) {
        my @fs = stat($from);
        if (@fs) {
            my @ts = stat($to);

diff --git a/lib/File/Copy.t b/lib/File/Copy.t
index 670f37c..0fcc130 100755 (executable)
--- a/lib/File/Copy.t
+++ b/lib/File/Copy.t
@@ -164,15 +164,19 @@ for my $pass (@pass) {
   }
 
   if ($Config{d_link}) {
-    open(F, ">file-$$") or die $!;
-    print F "dummy content\n";
-    close F;
-    link("file-$$", "hardlink-$$") or die $!;
-    eval { copy("file-$$", "hardlink-$$") };
-    print "not " if $@ !~ /are identical/ || -z "file-$$";
-    printf "ok %d\n", (++$test_i)+$loopconst;
-    unlink "hardlink-$$";
-    unlink "file-$$";
+    if ($^O ne 'MSWin32') {
+      open(F, ">file-$$") or die $!;
+      print F "dummy content\n";
+      close F;
+      link("file-$$", "hardlink-$$") or die $!;
+      eval { copy("file-$$", "hardlink-$$") };
+      print "not " if $@ !~ /are identical/ || -z "file-$$";
+      printf "ok %d\n", (++$test_i)+$loopconst;
+      unlink "hardlink-$$";
+      unlink "file-$$";
+    } else {
+      printf "ok %d # Skipped: can't test hardlinks on MSWin32\n", (++$test_i)+$loopconst;
+    }
   } else {
     printf "ok %d # Skipped: no hardlinks on this platform\n", (++$test_i)+$loopconst;
   }