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