foldable: make more understandable
[gnu-stow.git] / t / unstow_orig.t
blob94f771d3ebe50151f66e357774856a2b2a54dab2
1 #!/usr/bin/perl
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
22 use strict;
23 use warnings;
25 use File::Spec qw(make_path);
26 use Test::More tests => 17;
27 use Test::Output;
28 use English qw(-no_match_vars);
30 use testutil;
31 use Stow::Util qw(canon_path);
33 init_test_dirs();
34 cd("$TEST_DIR/target");
36 # Note that each of the following tests use a distinct set of files
38 my $stow;
39 my %conflicts;
41 subtest("unstow a simple tree minimally", sub {
42 plan tests => 3;
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');
54 });
56 subtest("unstow a simple tree from an existing directory", sub {
57 plan tests => 3;
58 my $stow = new_compat_Stow();
60 make_path('lib2');
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');
68 ok(-d 'lib2'
69 => 'unstow simple tree from a pre-existing directory'
71 });
73 subtest("fold tree after unstowing", sub {
74 plan tests => 3;
75 my $stow = new_compat_Stow();
77 make_path('bin3');
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);
89 ok(-l 'bin3');
90 is(readlink('bin3'), '../stow/pkg3a/bin3'
91 => 'fold tree after unstowing'
93 });
95 subtest("existing link is owned by stow but is invalid so it gets removed anyway", sub {
96 plan tests => 2;
97 my $stow = new_compat_Stow();
99 make_path('bin4');
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);
107 ok(! -e 'bin4/file4'
108 => q(remove invalid link owned by stow)
112 subtest("Existing link is not owned by stow", sub {
113 plan tests => 2;
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.
123 #like(
124 # $Conflicts[-1], qr(can't unlink.*not owned by stow)
125 # => q(existing link not owned by stow)
127 ok(-l 'bin5');
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 {
134 plan tests => 3;
135 my $stow = new_compat_Stow();
137 make_path('bin6');
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);
147 ok(-l 'bin6/file6');
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 {
155 plan tests => 5;
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');
164 capture_stderr();
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);
168 ok(-l 'stow/pkg7b');
169 ok(readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
170 => q(don't unlink any nodes under the stow directory)
172 like($stderr,
173 qr/WARNING: skipping target which was current stow directory stow/
174 => "warn when unstowing from ourself");
175 uncapture_stderr();
178 subtest("Don't unlink any nodes under another stow directory", sub {
179 plan tests => 5;
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');
190 capture_stderr();
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)
198 like($stderr,
199 qr/WARNING: skipping target which was current stow directory stow/
200 => "warn when skipping unstowing");
201 uncapture_stderr();
204 # This will be used by subsequent tests
205 sub check_protected_dirs_skipped {
206 for my $dir (qw{stow stow2}) {
207 like($stderr,
208 qr/WARNING: skipping marked Stow directory $dir/
209 => "warn when skipping marked directory $dir");
211 uncapture_stderr();
214 subtest("overriding already stowed documentation", sub {
215 plan tests => 4;
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');
227 capture_stderr();
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 {
238 plan tests => 5;
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');
253 capture_stderr();
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 {
264 plan tests => 4;
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');
274 capture_stderr();
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 {
283 plan tests => 4;
284 my $stow = new_compat_Stow();
285 capture_stderr();
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 {
296 plan tests => 4;
298 eval { remove_dir("$TEST_DIR/target"); };
299 mkdir("$TEST_DIR/target");
301 my $stow = new_compat_Stow();
302 capture_stderr();
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 {
313 plan tests => 5;
314 make_file('man12/man1/file12.1');
316 my $stow = new_compat_Stow();
317 capture_stderr();
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 {
330 plan tests => 3;
331 cd('../..');
332 my $stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
334 make_path("$TEST_DIR/stow/pkg13/bin13");
335 make_file("$TEST_DIR/stow/pkg13/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/pkg13/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 {
346 plan tests => 3;
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/pkg14/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 {
364 plan tests => 3;
365 my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
366 target => canon_path("$TEST_DIR/target"));
367 make_path("$TEST_DIR/stow/pkg15/bin15");
368 make_file("$TEST_DIR/stow/pkg15/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/pkg15/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 {
381 # TODO
382 # });