lib/File/Copy.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     push @INC, "::lib:$MacPerl::Architecture" if $^O eq 'MacOS';
   7 }
   8
   9 $| = 1;
  10
  11 my @pass = (0,1);
  12 my $tests = $^O eq 'MacOS' ? 17 : 14;
  13 printf "1..%d\n", $tests * scalar(@pass);
  14
  15 use File::Copy;
  16 use Config;
  17
  18 for my $pass (@pass) {
  19
  20   my $loopconst = $pass*$tests;
  21
  22   # First we create a file
  23   open(F, ">file-$$") or die;
  24   binmode F; # for DOSISH platforms, because test 3 copies to stdout
  25   printf F "ok %d\n", 3 + $loopconst;
  26   close F;
  27
  28   copy "file-$$", "copy-$$";
  29
  30   open(F, "copy-$$") or die;
  31   $foo = <F>;
  32   close(F);
  33
  34   print "not " if -s "file-$$" != -s "copy-$$";
  35   printf "ok %d\n", 1 + $loopconst;
  36
  37   print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
  38   printf "ok %d\n", 2+$loopconst;
  39
  40   binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
  41   copy "copy-$$", \*STDOUT;
  42   unlink "copy-$$" or die "unlink: $!";
  43
  44   open(F,"file-$$");
  45   copy(*F, "copy-$$");
  46   open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
  47   print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
  48   printf "ok %d\n", 4+$loopconst;
  49   unlink "copy-$$" or die "unlink: $!";
  50   open(F,"file-$$");
  51   copy(\*F, "copy-$$");
  52   close(F) or die "close: $!";
  53   open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
  54   print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
  55   printf "ok %d\n", 5+$loopconst;
  56   unlink "copy-$$" or die "unlink: $!";
  57
  58   require IO::File;
  59   $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!";
  60   binmode $fh or die;
  61   copy("file-$$",$fh);
  62   $fh->close or die "close: $!";
  63   open(R, "copy-$$") or die; $foo = <R>; close(R);
  64   print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
  65   printf "ok %d\n", 6+$loopconst;
  66   unlink "copy-$$" or die "unlink: $!";
  67   require FileHandle;
  68   my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!";
  69   binmode $fh or die;
  70   copy("file-$$",$fh);
  71   $fh->close;
  72   open(R, "copy-$$") or die; $foo = <R>; close(R);
  73   print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
  74   printf "ok %d\n", 7+$loopconst;
  75   unlink "file-$$" or die "unlink: $!";
  76
  77   print "# moved missing file.\nnot " if move("file-$$", "copy-$$");
  78   print "# target disappeared.\nnot " if not -e "copy-$$";
  79   printf "ok %d\n", 8+$loopconst;
  80
  81   move "copy-$$", "file-$$" or print "# move did not succeed.\n";
  82   print "# not moved: $!\nnot " unless -e "file-$$" and not -e "copy-$$";
  83   open(R, "file-$$") or die; $foo = <R>; close(R);
  84   print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
  85   printf "ok %d\n", 9+$loopconst;
  86
  87   my $test_i;
  88   if ($^O eq 'MacOS') {
  89
  90     copy "file-$$", "lib";
  91     open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
  92     print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
  93     printf "ok %d\n", 10+$loopconst;
  94     unlink ":lib:file-$$" or die "unlink: $!";
  95
  96     copy "file-$$", ":lib";
  97     open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
  98     print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
  99     printf "ok %d\n", 11+$loopconst;
 100     unlink ":lib:file-$$" or die "unlink: $!";
 101
 102     copy "file-$$", ":lib:";
 103     open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
 104     print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
 105     printf "ok %d\n", 12+$loopconst;
 106     unlink ":lib:file-$$" or die "unlink: $!";
 107
 108     unless (-e 'lib:') { # make sure there's no volume called 'lib'
 109         undef $@;
 110         eval { (copy "file-$$", "lib:") || die "'lib:' is not a volume name"; };
 111         print "# Died: $@";
 112         print "not " unless ( $@ =~ m|'lib:' is not a volume name| );
 113     }
 114     printf "ok %d\n", 13+$loopconst;
 115
 116     move "file-$$", ":lib:";
 117     open(R, ":lib:file-$$") or die "open :lib:file-$$: $!"; $foo = <R>; close(R);
 118     print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
 119         and not -e "file-$$";;
 120     printf "ok %d\n", 14+$loopconst;
 121
 122     eval { copy("copy-$$", "copy-$$") };
 123     printf "ok %d\n", 15+$loopconst
 124         unless $@ =~ /are identical/ && -s "copy-$$";
 125
 126     unlink ":lib:file-$$" or die "unlink: $!";
 127
 128     $test_i = 15;
 129   } else {
 130
 131     copy "file-$$", "lib";
 132     open(R, "lib/file-$$") or die; $foo = <R>; close(R);
 133     print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
 134     printf "ok %d\n", 10+$loopconst;
 135     unlink "lib/file-$$" or die "unlink: $!";
 136
 137     move "file-$$", "lib";
 138     open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R);
 139     print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
 140         and not -e "file-$$";;
 141     printf "ok %d\n", 11+$loopconst;
 142
 143     eval { copy("copy-$$", "copy-$$") };
 144     printf "ok %d\n", 12+$loopconst
 145         unless $@ =~ /are identical/ && -s "copy-$$";
 146
 147     unlink "lib/file-$$" or die "unlink: $!";
 148
 149     $test_i = 12;
 150   }
 151
 152   if ($Config{d_symlink}) {
 153     open(F, ">file-$$") or die $!;
 154     print F "dummy content\n";
 155     close F;
 156     symlink("file-$$", "symlink-$$") or die $!;
 157     eval { copy("file-$$", "symlink-$$") };
 158     print "not " if $@ !~ /are identical/ || -z "file-$$";
 159     printf "ok %d\n", (++$test_i)+$loopconst;
 160     unlink "symlink-$$";
 161     unlink "file-$$";
 162   } else {
 163     printf "ok %d # Skipped: no symlinks on this platform\n", (++$test_i)+$loopconst;
 164   }
 165
 166   if ($Config{d_link}) {
 167     open(F, ">file-$$") or die $!;
 168     print F "dummy content\n";
 169     close F;
 170     link("file-$$", "hardlink-$$") or die $!;
 171     eval { copy("file-$$", "hardlink-$$") };
 172     print "not " if $@ !~ /are identical/ || -z "file-$$";
 173     printf "ok %d\n", (++$test_i)+$loopconst;
 174     unlink "hardlink-$$";
 175     unlink "file-$$";
 176   } else {
 177     printf "ok %d # Skipped: no hardlinks on this platform\n", (++$test_i)+$loopconst;
 178   }
 179
 180 }
 181
 182
 183 END {
 184     1 while unlink "file-$$";
 185     if ($^O eq 'MacOS') {
 186         1 while unlink ":lib:file-$$";
 187     } else {
 188         1 while unlink "lib/file-$$";
 189     }
 190 }