1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 push @INC, "::lib:$MacPerl::Architecture" if $^O eq 'MacOS'; 7} 8 9$| = 1; 10 11my @pass = (0,1); 12my $tests = $^O eq 'MacOS' ? 15 : 12; 13printf "1..%d\n", $tests * scalar(@pass); 14 15use File::Copy; 16 17for 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 150END { 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} 158