t/unstow_orig.t

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