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' ? 17 : 14; 13printf "1..%d\n", $tests * scalar(@pass); 14 15use File::Copy; 16use Config; 17 18for 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 if ($^O ne 'MSWin32') { 168 open(F, ">file-$$") or die $!; 169 print F "dummy content\n"; 170 close F; 171 link("file-$$", "hardlink-$$") or die $!; 172 eval { copy("file-$$", "hardlink-$$") }; 173 print "not " if $@ !~ /are identical/ || -z "file-$$"; 174 printf "ok %d\n", (++$test_i)+$loopconst; 175 unlink "hardlink-$$"; 176 unlink "file-$$"; 177 } else { 178 printf "ok %d # Skipped: can't test hardlinks on MSWin32\n", (++$test_i)+$loopconst; 179 } 180 } else { 181 printf "ok %d # Skipped: no hardlinks on this platform\n", (++$test_i)+$loopconst; 182 } 183 184} 185 186 187END { 188 1 while unlink "file-$$"; 189 if ($^O eq 'MacOS') { 190 1 while unlink ":lib:file-$$"; 191 } else { 192 1 while unlink "lib/file-$$"; 193 } 194} 195