This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix File::Copy with hard links on Windows.
authorSteve Hay <SteveHay@planit.com>
Wed, 3 Dec 2003 10:53:02 +0000 (10:53 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Thu, 4 Dec 2003 12:00:28 +0000 (12:00 +0000)
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

lib/File/Copy.pm
lib/File/Copy.t

index a01192b..f5b22e2 100644 (file)
@@ -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);
index 670f37c..0fcc130 100755 (executable)
@@ -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;
   }