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