t/unstow_orig.t

   1 #!/usr/bin/perl
   2 #
   3 # This file is part of GNU Stow.
   4 #
   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.
   9 #
  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.
  14 #
  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/.
  17
  18 #
  19 # Test unstowing packages in compat mode
  20 #
  21
  22 use strict;
  23 use warnings;
  24
  25 use File::Spec qw(make_path);
  26 use Test::More tests => 37;
  27 use Test::Output;
  28 use English qw(-no_match_vars);
  29
  30 use testutil;
  31 use Stow::Util qw(canon_path);
  32
  33 init_test_dirs();
  34 cd("$TEST_DIR/target");
  35
  36 # Note that each of the following tests use a distinct set of files
  37
  38 my $stow;
  39 my %conflicts;
  40
  41 #
  42 # unstow a simple tree minimally
  43 #
  44
  45 $stow = new_compat_Stow();
  46
  47 make_path('../stow/pkg1/bin1');
  48 make_file('../stow/pkg1/bin1/file1');
  49 make_link('bin1', '../stow/pkg1/bin1');
  50
  51 $stow->plan_unstow('pkg1');
  52 $stow->process_tasks();
  53 ok(
  54     $stow->get_conflict_count == 0 &&
  55     -f '../stow/pkg1/bin1/file1' && ! -e 'bin1'
  56     => 'unstow a simple tree'
  57 );
  58
  59 #
  60 # unstow a simple tree from an existing directory
  61 #
  62 $stow = new_compat_Stow();
  63
  64 make_path('lib2');
  65 make_path('../stow/pkg2/lib2');
  66 make_file('../stow/pkg2/lib2/file2');
  67 make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
  68 $stow->plan_unstow('pkg2');
  69 $stow->process_tasks();
  70 ok(
  71     $stow->get_conflict_count == 0 &&
  72     -f '../stow/pkg2/lib2/file2' && -d 'lib2'
  73     => 'unstow simple tree from a pre-existing directory'
  74 );
  75
  76 #
  77 # fold tree after unstowing
  78 #
  79 $stow = new_compat_Stow();
  80
  81 make_path('bin3');
  82
  83 make_path('../stow/pkg3a/bin3');
  84 make_file('../stow/pkg3a/bin3/file3a');
  85 make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
  86
  87 make_path('../stow/pkg3b/bin3');
  88 make_file('../stow/pkg3b/bin3/file3b');
  89 make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
  90 $stow->plan_unstow('pkg3b');
  91 $stow->process_tasks();
  92 ok(
  93     $stow->get_conflict_count == 0 &&
  94     -l 'bin3' &&
  95     readlink('bin3') eq '../stow/pkg3a/bin3'
  96     => 'fold tree after unstowing'
  97 );
  98
  99 #
 100 # existing link is owned by stow but is invalid so it gets removed anyway
 101 #
 102 $stow = new_compat_Stow();
 103
 104 make_path('bin4');
 105 make_path('../stow/pkg4/bin4');
 106 make_file('../stow/pkg4/bin4/file4');
 107 make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
 108
 109 $stow->plan_unstow('pkg4');
 110 $stow->process_tasks();
 111 ok(
 112     $stow->get_conflict_count == 0 &&
 113     ! -e 'bin4/file4'
 114     => q(remove invalid link owned by stow)
 115 );
 116
 117 #
 118 # Existing link is not owned by stow
 119 #
 120 $stow = new_compat_Stow();
 121
 122 make_path('../stow/pkg5/bin5');
 123 make_invalid_link('bin5', '../not-stow');
 124
 125 $stow->plan_unstow('pkg5');
 126 # Unlike the corresponding stow_contents.t test, this doesn't
 127 # cause any conflicts.
 128 #
 129 #like(
 130 #    $Conflicts[-1], qr(can't unlink.*not owned by stow)
 131 #    => q(existing link not owned by stow)
 132 #);
 133 ok(
 134     -l 'bin5' && readlink('bin5') eq '../not-stow'
 135     => q(existing link not owned by stow)
 136 );
 137
 138 #
 139 # Target already exists, is owned by stow, but points to a different package
 140 #
 141 $stow = new_compat_Stow();
 142
 143 make_path('bin6');
 144 make_path('../stow/pkg6a/bin6');
 145 make_file('../stow/pkg6a/bin6/file6');
 146 make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
 147
 148 make_path('../stow/pkg6b/bin6');
 149 make_file('../stow/pkg6b/bin6/file6');
 150
 151 $stow->plan_unstow('pkg6b');
 152 ok(
 153     $stow->get_conflict_count == 0 &&
 154     -l 'bin6/file6' &&
 155     readlink('bin6/file6') eq '../../stow/pkg6a/bin6/file6'
 156     => q(ignore existing link that points to a different package)
 157 );
 158
 159 #
 160 # Don't unlink anything under the stow directory
 161 #
 162 make_path('stow'); # make out stow dir a subdir of target
 163 $stow = new_compat_Stow(dir => 'stow');
 164
 165 # emulate stowing into ourself (bizarre corner case or accident)
 166 make_path('stow/pkg7a/stow/pkg7b');
 167 make_file('stow/pkg7a/stow/pkg7b/file7b');
 168 make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
 169
 170 capture_stderr();
 171 $stow->plan_unstow('pkg7b');
 172 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
 173 ok(
 174     $stow->get_conflict_count == 0 &&
 175     -l 'stow/pkg7b' &&
 176     readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
 177     => q(don't unlink any nodes under the stow directory)
 178 );
 179 like($stderr,
 180      qr/WARNING: skipping target which was current stow directory stow/
 181      => "warn when unstowing from ourself");
 182 uncapture_stderr();
 183
 184 #
 185 # Don't unlink any nodes under another stow directory
 186 #
 187 $stow = new_compat_Stow(dir => 'stow');
 188
 189 make_path('stow2'); # make our alternate stow dir a subdir of target
 190 make_file('stow2/.stow');
 191
 192 # emulate stowing into ourself (bizarre corner case or accident)
 193 make_path('stow/pkg8a/stow2/pkg8b');
 194 make_file('stow/pkg8a/stow2/pkg8b/file8b');
 195 make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
 196
 197 capture_stderr();
 198 $stow->plan_unstow('pkg8a');
 199 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
 200 ok(
 201     $stow->get_conflict_count == 0 &&
 202     -l 'stow2/pkg8b' &&
 203     readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
 204     => q(don't unlink any nodes under another stow directory)
 205 );
 206 like($stderr,
 207      qr/WARNING: skipping target which was current stow directory stow/
 208      => "warn when skipping unstowing");
 209 uncapture_stderr();
 210
 211 #
 212 # overriding already stowed documentation
 213 #
 214
 215 # This will be used by this and subsequent tests
 216 sub check_protected_dirs_skipped {
 217     for my $dir (qw{stow stow2}) {
 218         like($stderr,
 219             qr/WARNING: skipping marked Stow directory $dir/
 220             => "warn when skipping marked directory $dir");
 221     }
 222     uncapture_stderr();
 223 }
 224
 225 $stow = new_compat_Stow(override => ['man9', 'info9']);
 226 make_file('stow/.stow');
 227
 228 make_path('../stow/pkg9a/man9/man1');
 229 make_file('../stow/pkg9a/man9/man1/file9.1');
 230 make_path('man9/man1');
 231 make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
 232
 233 make_path('../stow/pkg9b/man9/man1');
 234 make_file('../stow/pkg9b/man9/man1/file9.1');
 235 capture_stderr();
 236 $stow->plan_unstow('pkg9b');
 237 $stow->process_tasks();
 238 ok(
 239     $stow->get_conflict_count == 0 &&
 240     !-l 'man9/man1/file9.1'
 241     => 'overriding existing documentation files'
 242 );
 243 check_protected_dirs_skipped();
 244
 245 #
 246 # deferring to already stowed documentation
 247 #
 248 $stow = new_compat_Stow(defer => ['man10', 'info10']);
 249
 250 make_path('../stow/pkg10a/man10/man1');
 251 make_file('../stow/pkg10a/man10/man1/file10a.1');
 252 make_path('man10/man1');
 253 make_link('man10/man1/file10a.1'  => '../../../stow/pkg10a/man10/man1/file10a.1');
 254
 255 # need this to block folding
 256 make_path('../stow/pkg10b/man10/man1');
 257 make_file('../stow/pkg10b/man10/man1/file10b.1');
 258 make_link('man10/man1/file10b.1'  => '../../../stow/pkg10b/man10/man1/file10b.1');
 259
 260
 261 make_path('../stow/pkg10c/man10/man1');
 262 make_file('../stow/pkg10c/man10/man1/file10a.1');
 263 capture_stderr();
 264 $stow->plan_unstow('pkg10c');
 265 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
 266 ok(
 267     $stow->get_conflict_count == 0 &&
 268     readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
 269     => 'defer to existing documentation files'
 270 );
 271 check_protected_dirs_skipped();
 272
 273 #
 274 # Ignore temp files
 275 #
 276 $stow = new_compat_Stow(ignore => ['~', '\.#.*']);
 277
 278 make_path('../stow/pkg12/man12/man1');
 279 make_file('../stow/pkg12/man12/man1/file12.1');
 280 make_file('../stow/pkg12/man12/man1/file12.1~');
 281 make_file('../stow/pkg12/man12/man1/.#file12.1');
 282 make_path('man12/man1');
 283 make_link('man12/man1/file12.1'  => '../../../stow/pkg12/man12/man1/file12.1');
 284
 285 capture_stderr();
 286 $stow->plan_unstow('pkg12');
 287 $stow->process_tasks();
 288 ok(
 289     $stow->get_conflict_count == 0 &&
 290     !-e 'man12/man1/file12.1'
 291     => 'ignore temp files'
 292 );
 293 check_protected_dirs_skipped();
 294
 295 #
 296 # Unstow an already unstowed package
 297 #
 298 $stow = new_compat_Stow();
 299 capture_stderr();
 300 $stow->plan_unstow('pkg12');
 301 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
 302 ok(
 303     $stow->get_conflict_count == 0
 304     => 'unstow already unstowed package pkg12'
 305 );
 306 check_protected_dirs_skipped();
 307
 308 #
 309 # Unstow a never stowed package
 310 #
 311
 312 eval { remove_dir("$TEST_DIR/target"); };
 313 mkdir("$TEST_DIR/target");
 314
 315 $stow = new_compat_Stow();
 316 capture_stderr();
 317 $stow->plan_unstow('pkg12');
 318 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
 319 ok(
 320     $stow->get_conflict_count == 0
 321     => 'unstow never stowed package pkg12'
 322 );
 323 check_protected_dirs_skipped();
 324
 325 #
 326 # Unstowing when target contains a real file shouldn't be an issue.
 327 #
 328 make_file('man12/man1/file12.1');
 329
 330 $stow = new_compat_Stow();
 331 capture_stderr();
 332 $stow->plan_unstow('pkg12');
 333 is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
 334 %conflicts = $stow->get_conflicts;
 335 ok(
 336     $stow->get_conflict_count == 1 &&
 337     $conflicts{unstow}{pkg12}[0]
 338         =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
 339     => 'unstow pkg12 for third time'
 340 );
 341 check_protected_dirs_skipped();
 342
 343 #
 344 # unstow a simple tree minimally when cwd isn't target
 345 #
 346 cd('../..');
 347 $stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
 348
 349 make_path("$TEST_DIR/stow/pkg13/bin13");
 350 make_file("$TEST_DIR/stow/pkg13/bin13/file13");
 351 make_link("$TEST_DIR/target/bin13", '../stow/pkg13/bin13');
 352
 353 $stow->plan_unstow('pkg13');
 354 $stow->process_tasks();
 355 ok(
 356     $stow->get_conflict_count == 0 &&
 357     -f "$TEST_DIR/stow/pkg13/bin13/file13" && ! -e "$TEST_DIR/target/bin13"
 358     => 'unstow a simple tree'
 359 );
 360
 361 #
 362 # unstow a simple tree minimally with absolute stow dir when cwd isn't
 363 # target
 364 #
 365 $stow = new_Stow(dir    => canon_path("$TEST_DIR/stow"),
 366                  target => "$TEST_DIR/target");
 367
 368 make_path("$TEST_DIR/stow/pkg14/bin14");
 369 make_file("$TEST_DIR/stow/pkg14/bin14/file14");
 370 make_link("$TEST_DIR/target/bin14", '../stow/pkg14/bin14');
 371
 372 $stow->plan_unstow('pkg14');
 373 $stow->process_tasks();
 374 ok(
 375     $stow->get_conflict_count == 0 &&
 376     -f "$TEST_DIR/stow/pkg14/bin14/file14" && ! -e "$TEST_DIR/target/bin14"
 377     => 'unstow a simple tree with absolute stow dir'
 378 );
 379
 380 #
 381 # unstow a simple tree minimally with absolute stow AND target dirs
 382 # when cwd isn't target
 383 #
 384 $stow = new_Stow(dir    => canon_path("$TEST_DIR/stow"),
 385                  target => canon_path("$TEST_DIR/target"));
 386
 387 make_path("$TEST_DIR/stow/pkg15/bin15");
 388 make_file("$TEST_DIR/stow/pkg15/bin15/file15");
 389 make_link("$TEST_DIR/target/bin15", '../stow/pkg15/bin15');
 390
 391 $stow->plan_unstow('pkg15');
 392 $stow->process_tasks();
 393 ok(
 394     $stow->get_conflict_count == 0 &&
 395     -f "$TEST_DIR/stow/pkg15/bin15/file15" && ! -e "$TEST_DIR/target/bin15"
 396     => 'unstow a simple tree with absolute stow and target dirs'
 397 );
 398
 399
 400 # Todo
 401 #
 402 # Test cleaning up subdirs with --paranoid option
 403