lib/File/Copy.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use Test::More;
   9
  10 my $TB = Test::More->builder;
  11
  12 plan tests => 46;
  13
  14 use File::Copy;
  15 use Config;
  16
  17 for (1..2) {
  18
  19   # First we create a file
  20   open(F, ">file-$$") or die;
  21   binmode F; # for DOSISH platforms, because test 3 copies to stdout
  22   printf F "ok\n";
  23   close F;
  24
  25   copy "file-$$", "copy-$$";
  26
  27   open(F, "copy-$$") or die;
  28   $foo = <F>;
  29   close(F);
  30
  31   is -s "file-$$", -s "copy-$$";
  32
  33   is $foo, "ok\n";
  34
  35   binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
  36   # This outputs "ok" so its a test.
  37   copy "copy-$$", \*STDOUT;
  38   $TB->current_test($TB->current_test + 1);
  39   unlink "copy-$$" or die "unlink: $!";
  40
  41   open(F,"file-$$");
  42   copy(*F, "copy-$$");
  43   open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
  44   is $foo, "ok\n";
  45   unlink "copy-$$" or die "unlink: $!";
  46
  47   open(F,"file-$$");
  48   copy(\*F, "copy-$$");
  49   close(F) or die "close: $!";
  50   open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
  51   is $foo, "ok\n";
  52   unlink "copy-$$" or die "unlink: $!";
  53
  54   require IO::File;
  55   $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!";
  56   binmode $fh or die;
  57   copy("file-$$",$fh);
  58   $fh->close or die "close: $!";
  59   open(R, "copy-$$") or die; $foo = <R>; close(R);
  60   is $foo, "ok\n";
  61   unlink "copy-$$" or die "unlink: $!";
  62
  63   require FileHandle;
  64   my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!";
  65   binmode $fh or die;
  66   copy("file-$$",$fh);
  67   $fh->close;
  68   open(R, "copy-$$") or die; $foo = <R>; close(R);
  69   is $foo, "ok\n";
  70   unlink "file-$$" or die "unlink: $!";
  71
  72   ok !move("file-$$", "copy-$$"), "move on missing file";
  73   ok -e "copy-$$",                '  target still there';
  74
  75   ok move "copy-$$", "file-$$", 'move';
  76   ok -e "file-$$",              '  destination exists';
  77   ok !-e "copy-$$",              '  source does not';
  78   open(R, "file-$$") or die; $foo = <R>; close(R);
  79   is $foo, "ok\n";
  80
  81   copy "file-$$", "lib";
  82   open(R, "lib/file-$$") or die; $foo = <R>; close(R);
  83   is $foo, "ok\n";
  84   unlink "lib/file-$$" or die "unlink: $!";
  85
  86   # Do it twice to ensure copying over the same file works.
  87   copy "file-$$", "lib";
  88   open(R, "lib/file-$$") or die; $foo = <R>; close(R);
  89   is $foo, "ok\n";
  90   unlink "lib/file-$$" or die "unlink: $!";
  91
  92   eval { copy("file-$$", "file-$$") };
  93   like $@, qr/are identical/;
  94   ok -s "file-$$";
  95
  96   move "file-$$", "lib";
  97   open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R);
  98   is $foo, "ok\n";
  99   ok !-e "file-$$";
 100   unlink "lib/file-$$" or die "unlink: $!";
 101
 102   SKIP: {
 103     skip "Testing symlinks", 2 unless $Config{d_symlink};
 104
 105     open(F, ">file-$$") or die $!;
 106     print F "dummy content\n";
 107     close F;
 108     symlink("file-$$", "symlink-$$") or die $!;
 109     eval { copy("file-$$", "symlink-$$") };
 110     like $@, qr/are identical/;
 111     ok !-z "file-$$",
 112       'rt.perl.org 5196: copying to itself would truncate the file';
 113
 114     unlink "symlink-$$";
 115     unlink "file-$$";
 116   }
 117
 118   SKIP: {
 119     skip "Testing hard links", 2 if !$Config{d_link} or $^O eq 'MSWin32';
 120
 121     open(F, ">file-$$") or die $!;
 122     print F "dummy content\n";
 123     close F;
 124     link("file-$$", "hardlink-$$") or die $!;
 125     eval { copy("file-$$", "hardlink-$$") };
 126     like $@, qr/are identical/;
 127     ok ! -z "file-$$",
 128       'rt.perl.org 5196: copying to itself would truncate the file';
 129
 130     unlink "hardlink-$$";
 131     unlink "file-$$";
 132   }
 133
 134 }
 135
 136
 137 END {
 138     1 while unlink "file-$$";
 139     1 while unlink "lib/file-$$";
 140 }