This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
0fcc1306c41c2b13bf97dd4d10e5a61f76f24e5e
[perl5.git] / 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     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
187 END {
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 }