t/stow.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 stowing packages.
  20 #
  21
  22 use strict;
  23 use warnings;
  24
  25 use Test::More tests => 21;
  26 use Test::Output;
  27 use English qw(-no_match_vars);
  28
  29 use Stow::Util qw(canon_path set_debug_level);
  30 use testutil;
  31
  32 init_test_dirs();
  33 cd("$TEST_DIR/target");
  34
  35 my $stow;
  36 my %conflicts;
  37
  38 # Note that each of the following tests use a distinct set of files
  39
  40 subtest('stow a simple tree minimally', sub {
  41     plan tests => 2;
  42     my $stow = new_Stow(dir => '../stow');
  43
  44     make_path('../stow/pkg1/bin1');
  45     make_file('../stow/pkg1/bin1/file1');
  46
  47     $stow->plan_stow('pkg1');
  48     $stow->process_tasks();
  49     is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
  50     is(
  51         readlink('bin1'),
  52         '../stow/pkg1/bin1',
  53         => 'minimal stow of a simple tree'
  54     );
  55 });
  56
  57 subtest('stow a simple tree into an existing directory', sub {
  58     plan tests => 1;
  59     my $stow = new_Stow();
  60
  61     make_path('../stow/pkg2/lib2');
  62     make_file('../stow/pkg2/lib2/file2');
  63     make_path('lib2');
  64
  65     $stow->plan_stow('pkg2');
  66     $stow->process_tasks();
  67     is(
  68         readlink('lib2/file2'),
  69         '../../stow/pkg2/lib2/file2',
  70         => 'stow simple tree to existing directory'
  71     );
  72 });
  73
  74 subtest('unfold existing tree', sub {
  75     plan tests => 3;
  76     my $stow = new_Stow();
  77
  78     make_path('../stow/pkg3a/bin3');
  79     make_file('../stow/pkg3a/bin3/file3a');
  80     make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
  81
  82     make_path('../stow/pkg3b/bin3');
  83     make_file('../stow/pkg3b/bin3/file3b');
  84
  85     $stow->plan_stow('pkg3b');
  86     $stow->process_tasks();
  87     ok(-d 'bin3');
  88     is(readlink('bin3/file3a'), '../../stow/pkg3a/bin3/file3a');
  89     is(readlink('bin3/file3b'), '../../stow/pkg3b/bin3/file3b'
  90         => 'target already has 1 stowed package');
  91 });
  92
  93 subtest("Link to a new dir 'bin4' conflicts with existing non-dir so can't unfold", sub {
  94     plan tests => 2;
  95     my $stow = new_Stow();
  96
  97     make_file('bin4'); # this is a file but named like a directory
  98     make_path('../stow/pkg4/bin4');
  99     make_file('../stow/pkg4/bin4/file4');
 100
 101     $stow->plan_stow('pkg4');
 102     %conflicts = $stow->get_conflicts();
 103     is($stow->get_conflict_count, 1);
 104     ok($conflicts{stow}{pkg4}[0] =~
 105         qr/existing target is neither a link nor a directory/
 106         => 'link to new dir bin4 conflicts with existing non-directory'
 107     );
 108 });
 109
 110 subtest("Link to a new dir 'bin4a' conflicts with existing non-dir " .
 111         "so can't unfold even with --adopt", sub {
 112     plan tests => 2;
 113     #my $stow = new_Stow(adopt => 1);
 114     my $stow = new_Stow();
 115
 116     make_file('bin4a'); # this is a file but named like a directory
 117     make_path('../stow/pkg4a/bin4a');
 118     make_file('../stow/pkg4a/bin4a/file4a');
 119
 120     $stow->plan_stow('pkg4a');
 121     %conflicts = $stow->get_conflicts();
 122     is($stow->get_conflict_count, 1);
 123     like($conflicts{stow}{pkg4a}[0],
 124         qr/existing target is neither a link nor a directory/
 125         => 'link to new dir bin4a conflicts with existing non-directory'
 126     );
 127 });
 128
 129 subtest("Link to files 'file4b' and 'bin4b' conflict with existing files", sub {
 130     plan tests => 3;
 131     my $stow = new_Stow();
 132
 133     # Populate target
 134     make_file('file4b',       'file4b - version originally in target');
 135     make_path ('bin4b');
 136     make_file('bin4b/file4b', 'bin4b/file4b - version originally in target');
 137
 138     # Populate
 139     make_path ('../stow/pkg4b/bin4b');
 140     make_file('../stow/pkg4b/file4b',       'file4b - version originally in stow package');
 141     make_file('../stow/pkg4b/bin4b/file4b', 'bin4b/file4b - version originally in stow package');
 142
 143     $stow->plan_stow('pkg4b');
 144     %conflicts = $stow->get_conflicts();
 145     is($stow->get_conflict_count, 2 => 'conflict per file');
 146     for my $i (0, 1) {
 147         like(
 148             $conflicts{stow}{pkg4b}[$i],
 149             qr/existing target is neither a link nor a directory/
 150             => 'link to file4b conflicts with existing non-directory'
 151         );
 152     }
 153 });
 154
 155 subtest("Link to files 'file4b' and 'bin4b' do not conflict with existing", sub {
 156     plan tests => 8;
 157     my $stow = new_Stow(adopt => 1);
 158
 159     # Populate target
 160     make_file('file4c',       "file4c - version originally in target\n");
 161     make_path ('bin4c');
 162     make_file('bin4c/file4c', "bin4c/file4c - version originally in target\n");
 163
 164     # Populate
 165     make_path ('../stow/pkg4c/bin4c');
 166     make_file('../stow/pkg4c/file4c',       "file4c - version originally in stow package\n");
 167     make_file('../stow/pkg4c/bin4c/file4c', "bin4c/file4c - version originally in stow package\n");
 168
 169     $stow->plan_stow('pkg4c');
 170     is($stow->get_conflict_count, 0 => 'no conflicts with --adopt');
 171     is($stow->get_tasks, 4 => 'two tasks per file');
 172     $stow->process_tasks();
 173     for my $file ('file4c', 'bin4c/file4c') {
 174         ok(-l $file, "$file turned into a symlink");
 175         is(
 176             readlink $file,
 177             (index($file, '/') == -1 ? '' : '../' )
 178             . "../stow/pkg4c/$file" => "$file points to right place"
 179         );
 180         is(cat_file($file), "$file - version originally in target\n" => "$file has right contents");
 181     }
 182
 183 });
 184
 185 subtest("Target already exists but is not owned by stow", sub {
 186     plan tests => 1;
 187     my $stow = new_Stow();
 188
 189     make_path('bin5');
 190     make_invalid_link('bin5/file5','../../empty');
 191     make_path('../stow/pkg5/bin5/file5');
 192
 193     $stow->plan_stow('pkg5');
 194     %conflicts = $stow->get_conflicts();
 195     like(
 196         $conflicts{stow}{pkg5}[-1],
 197         qr/not owned by stow/
 198         => 'target already exists but is not owned by stow'
 199     );
 200 });
 201
 202 subtest("Replace existing but invalid target", sub {
 203     plan tests => 1;
 204     my $stow = new_Stow();
 205
 206     make_invalid_link('file6','../stow/path-does-not-exist');
 207     make_path('../stow/pkg6');
 208     make_file('../stow/pkg6/file6');
 209
 210     $stow->plan_stow('pkg6');
 211     $stow->process_tasks();
 212     is(
 213         readlink('file6'),
 214         '../stow/pkg6/file6'
 215         => 'replace existing but invalid target'
 216     );
 217 });
 218
 219 subtest("Target already exists, is owned by stow, but points to a non-directory", sub {
 220     plan tests => 1;
 221     my $stow = new_Stow();
 222     #set_debug_level(4);
 223
 224     make_path('bin7');
 225     make_path('../stow/pkg7a/bin7');
 226     make_file('../stow/pkg7a/bin7/node7');
 227     make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
 228     make_path('../stow/pkg7b/bin7/node7');
 229     make_file('../stow/pkg7b/bin7/node7/file7');
 230
 231     $stow->plan_stow('pkg7b');
 232     %conflicts = $stow->get_conflicts();
 233     like(
 234         $conflicts{stow}{pkg7b}[-1],
 235         qr/existing target is stowed to a different package/
 236         => 'link to new dir conflicts with existing stowed non-directory'
 237     );
 238 });
 239
 240 subtest("stowing directories named 0", sub {
 241     plan tests => 4;
 242     my $stow = new_Stow();
 243
 244     make_path('../stow/pkg8a/0');
 245     make_file('../stow/pkg8a/0/file8a');
 246     make_link('0' => '../stow/pkg8a/0'); # emulate stow
 247
 248     make_path('../stow/pkg8b/0');
 249     make_file('../stow/pkg8b/0/file8b');
 250
 251     $stow->plan_stow('pkg8b');
 252     $stow->process_tasks();
 253     is($stow->get_conflict_count, 0);
 254     ok(-d '0');
 255     is(readlink('0/file8a'), '../../stow/pkg8a/0/file8a');
 256     is(readlink('0/file8b'), '../../stow/pkg8b/0/file8b'
 257         => 'stowing directories named 0'
 258     );
 259 });
 260
 261 subtest("overriding already stowed documentation", sub {
 262     plan tests => 2;
 263     my $stow = new_Stow(override => ['man9', 'info9']);
 264
 265     make_path('../stow/pkg9a/man9/man1');
 266     make_file('../stow/pkg9a/man9/man1/file9.1');
 267     make_path('man9/man1');
 268     make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
 269
 270     make_path('../stow/pkg9b/man9/man1');
 271     make_file('../stow/pkg9b/man9/man1/file9.1');
 272
 273     $stow->plan_stow('pkg9b');
 274     $stow->process_tasks();
 275     is($stow->get_conflict_count, 0);
 276     is(readlink('man9/man1/file9.1'), '../../../stow/pkg9b/man9/man1/file9.1'
 277         => 'overriding existing documentation files'
 278     );
 279 });
 280
 281 subtest("deferring to already stowed documentation", sub {
 282     plan tests => 3;
 283     my $stow = new_Stow(defer => ['man10', 'info10']);
 284
 285     make_path('../stow/pkg10a/man10/man1');
 286     make_file('../stow/pkg10a/man10/man1/file10.1');
 287     make_path('man10/man1');
 288     make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1'); # emulate stow
 289
 290     make_path('../stow/pkg10b/man10/man1');
 291     make_file('../stow/pkg10b/man10/man1/file10.1');
 292
 293     $stow->plan_stow('pkg10b');
 294     is($stow->get_tasks, 0, 'no tasks to process');
 295     is($stow->get_conflict_count, 0);
 296     is(readlink('man10/man1/file10.1'), '../../../stow/pkg10a/man10/man1/file10.1'
 297         => 'defer to existing documentation files'
 298     );
 299 });
 300
 301 subtest("Ignore temp files", sub {
 302     plan tests => 4;
 303     my $stow = new_Stow(ignore => ['~', '\.#.*']);
 304
 305     make_path('../stow/pkg11/man11/man1');
 306     make_file('../stow/pkg11/man11/man1/file11.1');
 307     make_file('../stow/pkg11/man11/man1/file11.1~');
 308     make_file('../stow/pkg11/man11/man1/.#file11.1');
 309     make_path('man11/man1');
 310
 311     $stow->plan_stow('pkg11');
 312     $stow->process_tasks();
 313     is($stow->get_conflict_count, 0);
 314     is(readlink('man11/man1/file11.1'), '../../../stow/pkg11/man11/man1/file11.1');
 315     ok(!-e 'man11/man1/file11.1~');
 316     ok(!-e 'man11/man1/.#file11.1'
 317         => 'ignore temp files'
 318     );
 319 });
 320
 321 subtest("stowing links library files", sub {
 322     plan tests => 3;
 323     my $stow = new_Stow();
 324
 325     make_path('../stow/pkg12/lib12/');
 326     make_file('../stow/pkg12/lib12/lib.so.1');
 327     make_link('../stow/pkg12/lib12/lib.so', 'lib.so.1');
 328
 329     make_path('lib12/');
 330
 331     $stow->plan_stow('pkg12');
 332     $stow->process_tasks();
 333     is($stow->get_conflict_count, 0);
 334     is(readlink('lib12/lib.so.1'), '../../stow/pkg12/lib12/lib.so.1');
 335     is(readlink('lib12/lib.so'), '../../stow/pkg12/lib12/lib.so'
 336         => 'stow links to libraries'
 337     );
 338 });
 339
 340 subtest("unfolding to stow links to library files", sub {
 341     plan tests => 5;
 342     my $stow = new_Stow();
 343
 344     make_path('../stow/pkg13a/lib13/');
 345     make_file('../stow/pkg13a/lib13/liba.so.1');
 346     make_link('../stow/pkg13a/lib13/liba.so', 'liba.so.1');
 347     make_link('lib13','../stow/pkg13a/lib13');
 348
 349     make_path('../stow/pkg13b/lib13/');
 350     make_file('../stow/pkg13b/lib13/libb.so.1');
 351     make_link('../stow/pkg13b/lib13/libb.so', 'libb.so.1');
 352
 353     $stow->plan_stow('pkg13b');
 354     $stow->process_tasks();
 355     is($stow->get_conflict_count, 0);
 356     is(readlink('lib13/liba.so.1'), '../../stow/pkg13a/lib13/liba.so.1');
 357     is(readlink('lib13/liba.so'  ), '../../stow/pkg13a/lib13/liba.so');
 358     is(readlink('lib13/libb.so.1'), '../../stow/pkg13b/lib13/libb.so.1');
 359     is(readlink('lib13/libb.so'  ), '../../stow/pkg13b/lib13/libb.so'
 360        => 'unfolding to stow links to libraries'
 361     );
 362 });
 363
 364 subtest("stowing to stow dir should fail", sub {
 365     plan tests => 4;
 366     make_path('stow');
 367     $stow = new_Stow(dir => 'stow');
 368
 369     make_path('stow/pkg14/stow/pkg15');
 370     make_file('stow/pkg14/stow/pkg15/node15');
 371
 372     capture_stderr();
 373     $stow->plan_stow('pkg14');
 374     is($stow->get_tasks, 0, 'no tasks to process');
 375     is($stow->get_conflict_count, 0);
 376     ok(
 377         ! -l 'stow/pkg15'
 378         => "stowing to stow dir should fail"
 379     );
 380     like($stderr,
 381          qr/WARNING: skipping target which was current stow directory stow/
 382          => "stowing to stow dir should give warning");
 383     uncapture_stderr();
 384 });
 385
 386 subtest("stow a simple tree minimally when cwd isn't target", sub {
 387     plan tests => 2;
 388     cd('../..');
 389     $stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
 390
 391     make_path("$TEST_DIR/stow/pkg16/bin16");
 392     make_file("$TEST_DIR/stow/pkg16/bin16/file16");
 393
 394     $stow->plan_stow('pkg16');
 395     $stow->process_tasks();
 396     is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
 397     is(
 398         readlink("$TEST_DIR/target/bin16"),
 399         '../stow/pkg16/bin16',
 400         => "minimal stow of a simple tree when cwd isn't target"
 401     );
 402 });
 403
 404 subtest("stow a simple tree minimally to absolute stow dir when cwd isn't", sub {
 405     plan tests => 2;
 406     my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
 407                         target => "$TEST_DIR/target");
 408
 409     make_path("$TEST_DIR/stow/pkg17/bin17");
 410     make_file("$TEST_DIR/stow/pkg17/bin17/file17");
 411
 412     $stow->plan_stow('pkg17');
 413     $stow->process_tasks();
 414     is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
 415     is(
 416         readlink("$TEST_DIR/target/bin17"),
 417         '../stow/pkg17/bin17',
 418         => "minimal stow of a simple tree with absolute stow dir"
 419     );
 420 });
 421
 422 subtest("stow a simple tree minimally with absolute stow AND target dirs when", sub {
 423     plan tests => 2;
 424     my $stow = new_Stow(dir    => canon_path("$TEST_DIR/stow"),
 425                         target => canon_path("$TEST_DIR/target"));
 426
 427     make_path("$TEST_DIR/stow/pkg18/bin18");
 428     make_file("$TEST_DIR/stow/pkg18/bin18/file18");
 429
 430     $stow->plan_stow('pkg18');
 431     $stow->process_tasks();
 432     is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
 433     is(
 434         readlink("$TEST_DIR/target/bin18"),
 435         '../stow/pkg18/bin18',
 436         => "minimal stow of a simple tree with absolute stow and target dirs"
 437     );
 438 });
 439
 440 subtest("stow a tree with no-folding enabled", sub {
 441     plan tests => 82;
 442     # folded directories should be split open (unfolded) where
 443     # (and only where) necessary
 444     #
 445     cd("$TEST_DIR/target");
 446
 447     sub create_pkg {
 448         my ($id, $pkg) = @_;
 449
 450         my $stow_pkg = "../stow/$id-$pkg";
 451         make_path ($stow_pkg);
 452         make_file("$stow_pkg/$id-file-$pkg");
 453
 454         # create a shallow hierarchy specific to this package which isn't
 455         # yet stowed
 456         make_path ("$stow_pkg/$id-$pkg-only-new");
 457         make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
 458
 459         # create a deeper hierarchy specific to this package which isn't
 460         # yet stowed
 461         make_path ("$stow_pkg/$id-$pkg-only-new2/subdir");
 462         make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg");
 463         make_link("$stow_pkg/$id-$pkg-only-new2/current", "subdir");
 464
 465         # create a hierarchy specific to this package which is already
 466         # stowed via a folded tree
 467         make_path ("$stow_pkg/$id-$pkg-only-old");
 468         make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
 469         make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
 470
 471         # create a shared hierarchy which this package uses
 472         make_path ("$stow_pkg/$id-shared");
 473         make_file("$stow_pkg/$id-shared/$id-file-$pkg");
 474
 475         # create a partially shared hierarchy which this package uses
 476         make_path ("$stow_pkg/$id-shared2/subdir-$pkg");
 477         make_file("$stow_pkg/$id-shared2/$id-file-$pkg");
 478         make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
 479     }
 480
 481     foreach my $pkg (qw{a b}) {
 482         create_pkg('no-folding', $pkg);
 483     }
 484
 485     $stow = new_Stow('no-folding' => 1);
 486     $stow->plan_stow('no-folding-a');
 487     is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
 488     my @tasks = $stow->get_tasks;
 489     use Data::Dumper;
 490     is(scalar(@tasks), 13 => "6 dirs, 7 links") || warn Dumper(\@tasks);
 491     $stow->process_tasks();
 492
 493     sub check_no_folding {
 494         my ($pkg) = @_;
 495         my $stow_pkg = "../stow/no-folding-$pkg";
 496         is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
 497
 498         # check existing folded tree is untouched
 499         is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old");
 500
 501         # check newly stowed shallow tree is not folded
 502         is_dir_not_symlink("no-folding-$pkg-only-new");
 503         is_link("no-folding-$pkg-only-new/no-folding-file-$pkg",
 504                 "../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg");
 505
 506         # check newly stowed deeper tree is not folded
 507         is_dir_not_symlink("no-folding-$pkg-only-new2");
 508         is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
 509         is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
 510                 "../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
 511         is_link("no-folding-$pkg-only-new2/current",
 512                 "../$stow_pkg/no-folding-$pkg-only-new2/current");
 513
 514         # check shared tree is not folded. first time round this will be
 515         # newly stowed.
 516         is_dir_not_symlink('no-folding-shared');
 517         is_link("no-folding-shared/no-folding-file-$pkg",
 518                 "../$stow_pkg/no-folding-shared/no-folding-file-$pkg");
 519
 520         # check partially shared tree is not folded. first time round this
 521         # will be newly stowed.
 522         is_dir_not_symlink('no-folding-shared2');
 523         is_link("no-folding-shared2/no-folding-file-$pkg",
 524                 "../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
 525         is_link("no-folding-shared2/no-folding-file-$pkg",
 526                 "../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
 527     }
 528
 529     check_no_folding('a');
 530
 531     $stow = new_Stow('no-folding' => 1);
 532     $stow->plan_stow('no-folding-b');
 533     is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
 534     @tasks = $stow->get_tasks;
 535     is(scalar(@tasks), 11 => '4 dirs, 7 links') || warn Dumper(\@tasks);
 536     $stow->process_tasks();
 537
 538     check_no_folding('a');
 539     check_no_folding('b');
 540 });