t/unstow_contents_orig.t

   1 #!/usr/local/bin/perl
   2
   3 #
   4 # Testing unstow_contents_orig()
   5 #
   6
   7 use strict;
   8 use warnings;
   9
  10 use Test::More tests => 23;
  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     scalar($stow->get_conflicts) == 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     scalar($stow->get_conflicts) == 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     scalar($stow->get_conflicts) == 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_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
  92
  93 $stow->plan_unstow('pkg4');
  94 $stow->process_tasks();
  95 ok(
  96     scalar($stow->get_conflicts) == 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_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     scalar($stow->get_conflicts) == 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 $stow->plan_unstow('pkg7b');
 155 stderr_like(
 156   sub { $stow->process_tasks(); },
 157   qr/There are no outstanding operations to perform/,
 158   'no tasks to process when unstowing pkg7b'
 159 );
 160 ok(
 161     scalar($stow->get_conflicts) == 0 &&
 162     -l 'stow/pkg7b' &&
 163     readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
 164     => q(don't unlink any nodes under the stow directory)
 165 );
 166
 167 #
 168 # Don't unlink any nodes under another stow directory
 169 #
 170 $stow = new_compat_Stow(dir => 'stow');
 171
 172 make_dir('stow2'); # make our alternate stow dir a subdir of target
 173 make_file('stow2/.stow');
 174
 175 # emulate stowing into ourself (bizarre corner case or accident)
 176 make_dir('stow/pkg8a/stow2/pkg8b');
 177 make_file('stow/pkg8a/stow2/pkg8b/file8b');
 178 make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
 179
 180 $stow->plan_unstow('pkg8a');
 181 stderr_like(
 182   sub { $stow->process_tasks(); },
 183   qr/There are no outstanding operations to perform/,
 184   'no tasks to process when unstowing pkg8a'
 185 );
 186 ok(
 187     scalar($stow->get_conflicts) == 0 &&
 188     -l 'stow2/pkg8b' &&
 189     readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
 190     => q(don't unlink any nodes under another stow directory)
 191 );
 192
 193 #
 194 # overriding already stowed documentation
 195 #
 196 $stow = new_compat_Stow(override => ['man9', 'info9']);
 197 make_file('stow/.stow');
 198
 199 make_dir('../stow/pkg9a/man9/man1');
 200 make_file('../stow/pkg9a/man9/man1/file9.1');
 201 make_dir('man9/man1');
 202 make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
 203
 204 make_dir('../stow/pkg9b/man9/man1');
 205 make_file('../stow/pkg9b/man9/man1/file9.1');
 206 $stow->plan_unstow('pkg9b');
 207 $stow->process_tasks();
 208 ok(
 209     scalar($stow->get_conflicts) == 0 &&
 210     !-l 'man9/man1/file9.1'
 211     => 'overriding existing documentation files'
 212 );
 213
 214 #
 215 # deferring to already stowed documentation
 216 #
 217 $stow = new_compat_Stow(defer => ['man10', 'info10']);
 218
 219 make_dir('../stow/pkg10a/man10/man1');
 220 make_file('../stow/pkg10a/man10/man1/file10a.1');
 221 make_dir('man10/man1');
 222 make_link('man10/man1/file10a.1'  => '../../../stow/pkg10a/man10/man1/file10a.1');
 223
 224 # need this to block folding
 225 make_dir('../stow/pkg10b/man10/man1');
 226 make_file('../stow/pkg10b/man10/man1/file10b.1');
 227 make_link('man10/man1/file10b.1'  => '../../../stow/pkg10b/man10/man1/file10b.1');
 228
 229
 230 make_dir('../stow/pkg10c/man10/man1');
 231 make_file('../stow/pkg10c/man10/man1/file10a.1');
 232 $stow->plan_unstow('pkg10c');
 233 stderr_like(
 234   sub { $stow->process_tasks(); },
 235   qr/There are no outstanding operations to perform/,
 236   'no tasks to process when unstowing pkg10c'
 237 );
 238 ok(
 239     scalar($stow->get_conflicts) == 0 &&
 240     readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
 241     => 'defer to existing documentation files'
 242 );
 243
 244 #
 245 # Ignore temp files
 246 #
 247 $stow = new_compat_Stow(ignore => ['~', '\.#.*']);
 248
 249 make_dir('../stow/pkg12/man12/man1');
 250 make_file('../stow/pkg12/man12/man1/file12.1');
 251 make_file('../stow/pkg12/man12/man1/file12.1~');
 252 make_file('../stow/pkg12/man12/man1/.#file12.1');
 253 make_dir('man12/man1');
 254 make_link('man12/man1/file12.1'  => '../../../stow/pkg12/man12/man1/file12.1');
 255
 256 $stow->plan_unstow('pkg12');
 257 $stow->process_tasks();
 258 ok(
 259     scalar($stow->get_conflicts) == 0 &&
 260     !-e 'man12/man1/file12.1'
 261     => 'ignore temp files'
 262 );
 263
 264 #
 265 # Unstow an already unstowed package
 266 #
 267 $stow = new_compat_Stow();
 268 $stow->plan_unstow('pkg12');
 269 stderr_like(
 270   sub { $stow->process_tasks(); },
 271   qr/There are no outstanding operations to perform/,
 272   'no tasks to process when unstowing pkg12'
 273 );
 274 ok(
 275     scalar($stow->get_conflicts) == 0
 276     => 'unstow already unstowed package pkg12'
 277 );
 278
 279 #
 280 # Unstow a never stowed package
 281 #
 282
 283 eval { remove_dir("$OUT_DIR/target"); };
 284 mkdir("$OUT_DIR/target");
 285
 286 $stow = new_compat_Stow();
 287 $stow->plan_unstow('pkg12');
 288 stderr_like(
 289   sub { $stow->process_tasks(); },
 290   qr/There are no outstanding operations to perform/,
 291   'no tasks to process when unstowing pkg12 which was never stowed'
 292 );
 293 ok(
 294     scalar($stow->get_conflicts) == 0
 295     => 'unstow never stowed package pkg12'
 296 );
 297
 298 #
 299 # Unstowing when target contains a real file shouldn't be an issue.
 300 #
 301 make_file('man12/man1/file12.1');
 302
 303 $stow = new_compat_Stow();
 304 $stow->plan_unstow('pkg12');
 305 stderr_like(
 306   sub { $stow->process_tasks(); },
 307   qr/There are no outstanding operations to perform/,
 308   'no tasks to process when unstowing pkg12 for third time'
 309 );
 310 %conflicts = $stow->get_conflicts;
 311 ok(
 312     $stow->get_conflict_count == 1 &&
 313     $conflicts{unstow}{pkg12}[0]
 314         =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
 315     => 'unstow pkg12 for third time'
 316 );
 317
 318 #
 319 # unstow a simple tree minimally when cwd isn't target
 320 #
 321 cd('../..');
 322 $stow = new_Stow(dir => "$OUT_DIR/stow", target => "$OUT_DIR/target");
 323
 324 make_dir("$OUT_DIR/stow/pkg13/bin13");
 325 make_file("$OUT_DIR/stow/pkg13/bin13/file13");
 326 make_link("$OUT_DIR/target/bin13", '../stow/pkg13/bin13');
 327
 328 $stow->plan_unstow('pkg13');
 329 $stow->process_tasks();
 330 ok(
 331     $stow->get_conflict_count == 0 &&
 332     -f "$OUT_DIR/stow/pkg13/bin13/file13" && ! -e "$OUT_DIR/target/bin13"
 333     => 'unstow a simple tree'
 334 );
 335
 336 #
 337 # unstow a simple tree minimally with absolute stow dir when cwd isn't
 338 # target
 339 #
 340 $stow = new_Stow(dir    => canon_path("$OUT_DIR/stow"),
 341                  target => "$OUT_DIR/target");
 342
 343 make_dir("$OUT_DIR/stow/pkg14/bin14");
 344 make_file("$OUT_DIR/stow/pkg14/bin14/file14");
 345 make_link("$OUT_DIR/target/bin14", '../stow/pkg14/bin14');
 346
 347 $stow->plan_unstow('pkg14');
 348 $stow->process_tasks();
 349 ok(
 350     scalar($stow->get_conflicts) == 0 &&
 351     -f "$OUT_DIR/stow/pkg14/bin14/file14" && ! -e "$OUT_DIR/target/bin14"
 352     => 'unstow a simple tree with absolute stow dir'
 353 );
 354
 355 #
 356 # unstow a simple tree minimally with absolute stow AND target dirs
 357 # when cwd isn't target
 358 #
 359 $stow = new_Stow(dir    => canon_path("$OUT_DIR/stow"),
 360                  target => canon_path("$OUT_DIR/target"));
 361
 362 make_dir("$OUT_DIR/stow/pkg15/bin15");
 363 make_file("$OUT_DIR/stow/pkg15/bin15/file15");
 364 make_link("$OUT_DIR/target/bin15", '../stow/pkg15/bin15');
 365
 366 $stow->plan_unstow('pkg15');
 367 $stow->process_tasks();
 368 ok(
 369     scalar($stow->get_conflicts) == 0 &&
 370     -f "$OUT_DIR/stow/pkg15/bin15/file15" && ! -e "$OUT_DIR/target/bin15"
 371     => 'unstow a simple tree with absolute stow and target dirs'
 372 );
 373
 374
 375 # Todo
 376 #
 377 # Test cleaning up subdirs with --paranoid option
 378