Commit | Line | Data |
1a3850a5 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
1a3850a5 |
6 | } |
7 | |
83519ebf |
8 | use Test::More; |
1a3850a5 |
9 | |
83519ebf |
10 | my $TB = Test::More->builder; |
11 | |
12 | plan tests => 46; |
1a04d035 |
13 | |
1a3850a5 |
14 | use File::Copy; |
ac7b122d |
15 | use Config; |
1a3850a5 |
16 | |
83519ebf |
17 | for (1..2) { |
1a04d035 |
18 | |
19 | # First we create a file |
20 | open(F, ">file-$$") or die; |
21 | binmode F; # for DOSISH platforms, because test 3 copies to stdout |
83519ebf |
22 | printf F "ok\n"; |
1a04d035 |
23 | close F; |
24 | |
25 | copy "file-$$", "copy-$$"; |
26 | |
27 | open(F, "copy-$$") or die; |
28 | $foo = <F>; |
29 | close(F); |
30 | |
83519ebf |
31 | is -s "file-$$", -s "copy-$$"; |
1a04d035 |
32 | |
83519ebf |
33 | is $foo, "ok\n"; |
1a04d035 |
34 | |
35 | binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode |
83519ebf |
36 | # This outputs "ok" so its a test. |
1a04d035 |
37 | copy "copy-$$", \*STDOUT; |
83519ebf |
38 | $TB->current_test($TB->current_test + 1); |
1a04d035 |
39 | unlink "copy-$$" or die "unlink: $!"; |
40 | |
41 | open(F,"file-$$"); |
42 | copy(*F, "copy-$$"); |
43 | open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R); |
83519ebf |
44 | is $foo, "ok\n"; |
1a04d035 |
45 | unlink "copy-$$" or die "unlink: $!"; |
83519ebf |
46 | |
1a04d035 |
47 | open(F,"file-$$"); |
48 | copy(\*F, "copy-$$"); |
49 | close(F) or die "close: $!"; |
50 | open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!"; |
83519ebf |
51 | is $foo, "ok\n"; |
1a04d035 |
52 | unlink "copy-$$" or die "unlink: $!"; |
53 | |
54 | require IO::File; |
55 | $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!"; |
56 | binmode $fh or die; |
57 | copy("file-$$",$fh); |
58 | $fh->close or die "close: $!"; |
59 | open(R, "copy-$$") or die; $foo = <R>; close(R); |
83519ebf |
60 | is $foo, "ok\n"; |
1a04d035 |
61 | unlink "copy-$$" or die "unlink: $!"; |
83519ebf |
62 | |
1a04d035 |
63 | require FileHandle; |
64 | my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!"; |
65 | binmode $fh or die; |
66 | copy("file-$$",$fh); |
67 | $fh->close; |
68 | open(R, "copy-$$") or die; $foo = <R>; close(R); |
83519ebf |
69 | is $foo, "ok\n"; |
1a04d035 |
70 | unlink "file-$$" or die "unlink: $!"; |
71 | |
83519ebf |
72 | ok !move("file-$$", "copy-$$"), "move on missing file"; |
73 | ok -e "copy-$$", ' target still there'; |
1a04d035 |
74 | |
83519ebf |
75 | ok move "copy-$$", "file-$$", 'move'; |
76 | ok -e "file-$$", ' destination exists'; |
77 | ok !-e "copy-$$", ' source does not'; |
1a04d035 |
78 | open(R, "file-$$") or die; $foo = <R>; close(R); |
83519ebf |
79 | is $foo, "ok\n"; |
80 | |
81 | copy "file-$$", "lib"; |
82 | open(R, "lib/file-$$") or die; $foo = <R>; close(R); |
83 | is $foo, "ok\n"; |
84 | unlink "lib/file-$$" or die "unlink: $!"; |
85 | |
86 | # Do it twice to ensure copying over the same file works. |
87 | copy "file-$$", "lib"; |
88 | open(R, "lib/file-$$") or die; $foo = <R>; close(R); |
89 | is $foo, "ok\n"; |
90 | unlink "lib/file-$$" or die "unlink: $!"; |
91 | |
92 | eval { copy("file-$$", "file-$$") }; |
93 | like $@, qr/are identical/; |
94 | ok -s "file-$$"; |
95 | |
96 | move "file-$$", "lib"; |
97 | open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R); |
98 | is $foo, "ok\n"; |
99 | ok !-e "file-$$"; |
100 | unlink "lib/file-$$" or die "unlink: $!"; |
101 | |
102 | SKIP: { |
103 | skip "Testing symlinks", 2 unless $Config{d_symlink}; |
ac7b122d |
104 | |
ac7b122d |
105 | open(F, ">file-$$") or die $!; |
106 | print F "dummy content\n"; |
107 | close F; |
108 | symlink("file-$$", "symlink-$$") or die $!; |
109 | eval { copy("file-$$", "symlink-$$") }; |
83519ebf |
110 | like $@, qr/are identical/; |
111 | ok !-z "file-$$", |
112 | 'rt.perl.org 5196: copying to itself would truncate the file'; |
113 | |
ac7b122d |
114 | unlink "symlink-$$"; |
115 | unlink "file-$$"; |
6c254d95 |
116 | } |
ac7b122d |
117 | |
83519ebf |
118 | SKIP: { |
119 | skip "Testing hard links", 2 if !$Config{d_link} or $^O eq 'MSWin32'; |
120 | |
121 | open(F, ">file-$$") or die $!; |
122 | print F "dummy content\n"; |
123 | close F; |
124 | link("file-$$", "hardlink-$$") or die $!; |
125 | eval { copy("file-$$", "hardlink-$$") }; |
126 | like $@, qr/are identical/; |
127 | ok ! -z "file-$$", |
128 | 'rt.perl.org 5196: copying to itself would truncate the file'; |
129 | |
130 | unlink "hardlink-$$"; |
131 | unlink "file-$$"; |
ac7b122d |
132 | } |
133 | |
1a04d035 |
134 | } |
135 | |
441496b2 |
136 | |
cfcb0b09 |
137 | END { |
138 | 1 while unlink "file-$$"; |
83519ebf |
139 | 1 while unlink "lib/file-$$"; |
cfcb0b09 |
140 | } |