3 # This file is part of GNU Stow.
5 # GNU Stow is free software: you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation, either version 3 of the License, or
8 # (at your option) any later version.
10 # GNU Stow is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program. If not, see https://www.gnu.org/licenses/.
19 # Test unstowing packages in compat mode
25 use File
::Spec
qw(make_path);
26 use Test
::More tests
=> 17;
28 use English
qw(-no_match_vars);
31 use Stow
::Util
qw(canon_path);
34 cd
("$TEST_DIR/target");
36 # Note that each of the following tests use a distinct set of files
41 subtest
("unstow a simple tree minimally", sub {
43 my $stow = new_compat_Stow
();
45 make_path
('../stow/pkg1/bin1');
46 make_file
('../stow/pkg1/bin1/file1');
47 make_link
('bin1', '../stow/pkg1/bin1');
49 $stow->plan_unstow('pkg1');
50 $stow->process_tasks();
51 is
($stow->get_conflict_count, 0);
52 ok
(-f
'../stow/pkg1/bin1/file1');
53 ok
(! -e
'bin1' => 'unstow a simple tree');
56 subtest
("unstow a simple tree from an existing directory", sub {
58 my $stow = new_compat_Stow
();
61 make_path
('../stow/pkg2/lib2');
62 make_file
('../stow/pkg2/lib2/file2');
63 make_link
('lib2/file2', '../../stow/pkg2/lib2/file2');
64 $stow->plan_unstow('pkg2');
65 $stow->process_tasks();
66 is
($stow->get_conflict_count, 0);
67 ok
(-f
'../stow/pkg2/lib2/file2');
69 => 'unstow simple tree from a pre-existing directory'
73 subtest
("fold tree after unstowing", sub {
75 my $stow = new_compat_Stow
();
79 make_path
('../stow/pkg3a/bin3');
80 make_file
('../stow/pkg3a/bin3/file3a');
81 make_link
('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
83 make_path
('../stow/pkg3b/bin3');
84 make_file
('../stow/pkg3b/bin3/file3b');
85 make_link
('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
86 $stow->plan_unstow('pkg3b');
87 $stow->process_tasks();
88 is
($stow->get_conflict_count, 0);
90 is
(readlink('bin3'), '../stow/pkg3a/bin3'
91 => 'fold tree after unstowing'
95 subtest
("existing link is owned by stow but is invalid so it gets removed anyway", sub {
97 my $stow = new_compat_Stow
();
100 make_path
('../stow/pkg4/bin4');
101 make_file
('../stow/pkg4/bin4/file4');
102 make_invalid_link
('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
104 $stow->plan_unstow('pkg4');
105 $stow->process_tasks();
106 is
($stow->get_conflict_count, 0);
108 => q
(remove invalid
link owned by stow
)
112 subtest
("Existing link is not owned by stow", sub {
114 my $stow = new_compat_Stow
();
116 make_path
('../stow/pkg5/bin5');
117 make_invalid_link
('bin5', '../not-stow');
119 $stow->plan_unstow('pkg5');
120 # Unlike the corresponding stow_contents.t test, this doesn't
121 # cause any conflicts.
124 # $Conflicts[-1], qr(can't unlink.*not owned by stow)
125 # => q(existing link not owned by stow)
128 ok
(readlink('bin5') eq '../not-stow'
129 => q
(existing
link not owned by stow
)
133 subtest
("Target already exists, is owned by stow, but points to a different package", sub {
135 my $stow = new_compat_Stow
();
138 make_path
('../stow/pkg6a/bin6');
139 make_file
('../stow/pkg6a/bin6/file6');
140 make_link
('bin6/file6', '../../stow/pkg6a/bin6/file6');
142 make_path
('../stow/pkg6b/bin6');
143 make_file
('../stow/pkg6b/bin6/file6');
145 $stow->plan_unstow('pkg6b');
146 is
($stow->get_conflict_count, 0);
149 readlink('bin6/file6') eq '../../stow/pkg6a/bin6/file6'
150 => q
(ignore existing
link that points to a different
package)
154 subtest
("Don't unlink anything under the stow directory", sub {
156 make_path
('stow'); # make stow dir a subdir of target
157 my $stow = new_compat_Stow
(dir
=> 'stow');
159 # emulate stowing into ourself (bizarre corner case or accident)
160 make_path
('stow/pkg7a/stow/pkg7b');
161 make_file
('stow/pkg7a/stow/pkg7b/file7b');
162 make_link
('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
165 $stow->plan_unstow('pkg7b');
166 is
($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
167 is
($stow->get_conflict_count, 0);
169 ok
(readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
170 => q
(don
't unlink any nodes under the stow directory)
173 qr/WARNING: skipping target which was current stow directory stow/
174 => "warn when unstowing from ourself");
178 subtest("Don't
unlink any nodes under another stow directory
", sub {
180 my $stow = new_compat_Stow(dir => 'stow');
182 make_path('stow2'); # make our alternate stow dir a subdir of target
183 make_file('stow2/.stow');
185 # emulate stowing into ourself (bizarre corner case or accident)
186 make_path('stow/pkg8a/stow2/pkg8b');
187 make_file('stow/pkg8a/stow2/pkg8b/file8b');
188 make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
191 $stow->plan_unstow('pkg8a');
192 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
193 is($stow->get_conflict_count, 0);
194 ok(-l 'stow2/pkg8b');
195 ok(readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
196 => q(don't unlink any nodes under another stow directory)
199 qr/WARNING: skipping target which was current stow directory stow/
200 => "warn when skipping unstowing
");
204 # This will be used by subsequent tests
205 sub check_protected_dirs_skipped {
206 for my $dir (qw{stow stow2}) {
208 qr/WARNING: skipping marked Stow directory $dir/
209 => "warn when skipping marked directory
$dir");
214 subtest("overriding already stowed documentation
", sub {
217 my $stow = new_compat_Stow(override => ['man9', 'info9']);
218 make_file('stow/.stow');
220 make_path('../stow/pkg9a/man9/man1');
221 make_file('../stow/pkg9a/man9/man1/file9.1');
222 make_path('man9/man1');
223 make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
225 make_path('../stow/pkg9b/man9/man1');
226 make_file('../stow/pkg9b/man9/man1/file9.1');
228 $stow->plan_unstow('pkg9b');
229 $stow->process_tasks();
230 is($stow->get_conflict_count, 0);
231 ok(!-l 'man9/man1/file9.1'
232 => 'overriding existing documentation files'
234 check_protected_dirs_skipped();
237 subtest("deferring to already stowed documentation
", sub {
239 my $stow = new_compat_Stow(defer => ['man10', 'info10']);
241 make_path('../stow/pkg10a/man10/man1');
242 make_file('../stow/pkg10a/man10/man1/file10a.1');
243 make_path('man10/man1');
244 make_link('man10/man1/file10a.1' => '../../../stow/pkg10a/man10/man1/file10a.1');
246 # need this to block folding
247 make_path('../stow/pkg10b/man10/man1');
248 make_file('../stow/pkg10b/man10/man1/file10b.1');
249 make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
251 make_path('../stow/pkg10c/man10/man1');
252 make_file('../stow/pkg10c/man10/man1/file10a.1');
254 $stow->plan_unstow('pkg10c');
255 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
256 is($stow->get_conflict_count, 0);
257 ok(readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
258 => 'defer to existing documentation files'
260 check_protected_dirs_skipped();
263 subtest("Ignore temp files
", sub {
265 my $stow = new_compat_Stow(ignore => ['~', '\.#.*']);
267 make_path('../stow/pkg12/man12/man1');
268 make_file('../stow/pkg12/man12/man1/file12.1');
269 make_file('../stow/pkg12/man12/man1/file12.1~');
270 make_file('../stow/pkg12/man12/man1/.#file12.1');
271 make_path('man12/man1');
272 make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
275 $stow->plan_unstow('pkg12');
276 $stow->process_tasks();
277 is($stow->get_conflict_count, 0);
278 ok(!-e 'man12/man1/file12.1' => 'ignore temp files');
279 check_protected_dirs_skipped();
282 subtest("Unstow an already unstowed
package", sub {
284 my $stow = new_compat_Stow();
286 $stow->plan_unstow('pkg12');
287 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
289 $stow->get_conflict_count == 0
290 => 'unstow already unstowed package pkg12'
292 check_protected_dirs_skipped();
295 subtest("Unstow a never stowed
package", sub {
298 eval { remove_dir("$TEST_DIR/target
"); };
299 mkdir("$TEST_DIR/target
");
301 my $stow = new_compat_Stow();
303 $stow->plan_unstow('pkg12');
304 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
306 $stow->get_conflict_count == 0
307 => 'unstow never stowed package pkg12'
309 check_protected_dirs_skipped();
312 subtest("Unstowing
when target contains a real file shouldn
't be an issue", sub {
314 make_file('man12
/man1/file12
.1
');
316 my $stow = new_compat_Stow();
318 $stow->plan_unstow('pkg12
');
319 is($stow->get_tasks, 0, 'no tasks to process
when unstowing pkg12
for third
time');
320 %conflicts = $stow->get_conflicts;
321 ok($stow->get_conflict_count == 1);
322 ok($conflicts{unstow}{pkg12}[0]
323 =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
324 => 'unstow pkg12
for third
time'
326 check_protected_dirs_skipped();
329 subtest("unstow a simple tree minimally when cwd isn't target
", sub {
332 my $stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target
");
334 make_path("$TEST_DIR/stow/pkg
13/bin13
");
335 make_file("$TEST_DIR/stow/pkg
13/bin13/file13
");
336 make_link("$TEST_DIR/target/bin13
", '../stow/pkg13/bin13');
338 $stow->plan_unstow('pkg13');
339 $stow->process_tasks();
340 is($stow->get_conflict_count, 0);
341 ok(-f "$TEST_DIR/stow/pkg
13/bin13/file13
");
342 ok(! -e "$TEST_DIR/target/bin13
" => 'unstow a simple tree');
345 subtest("unstow a simple tree minimally with absolute stow dir
when cwd isn
't target", sub {
347 my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
348 target => "$TEST_DIR/target");
350 make_path("$TEST_DIR/stow/pkg14/bin14");
351 make_file("$TEST_DIR/stow/pkg14/bin14/file14");
352 make_link("$TEST_DIR/target/bin14", '../stow/pkg
14/bin14
');
354 $stow->plan_unstow('pkg14
');
355 $stow->process_tasks();
356 is($stow->get_conflict_count, 0);
357 ok(-f "$TEST_DIR/stow/pkg14/bin14/file14");
358 ok(! -e "$TEST_DIR/target/bin14"
359 => 'unstow a simple tree with absolute stow dir
'
363 subtest("unstow a simple tree minimally with absolute stow AND target dirs when cwd isn't target
", sub {
365 my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow
"),
366 target => canon_path("$TEST_DIR/target
"));
367 make_path("$TEST_DIR/stow/pkg
15/bin15
");
368 make_file("$TEST_DIR/stow/pkg
15/bin15/file15
");
369 make_link("$TEST_DIR/target/bin15
", '../stow/pkg15/bin15');
371 $stow->plan_unstow('pkg15');
372 $stow->process_tasks();
373 is($stow->get_conflict_count, 0);
374 ok(-f "$TEST_DIR/stow/pkg
15/bin15/file15
");
375 ok(! -e "$TEST_DIR/target/bin15
"
376 => 'unstow a simple tree with absolute stow and target dirs'
380 # subtest("Test cleaning up subdirs with
--paranoid option
", sub {