t/stow: convert to subtests()

This commit is contained in:
Adam Spiers 2024-04-01 01:55:31 +01:00
parent 0871a483cf
commit a328c2cd4b

884
t/stow.t
View file

@ -22,7 +22,7 @@
use strict; use strict;
use warnings; use warnings;
use Test::More tests => 118; use Test::More tests => 21;
use Test::Output; use Test::Output;
use English qw(-no_match_vars); use English qw(-no_match_vars);
@ -37,520 +37,504 @@ my %conflicts;
# Note that each of the following tests use a distinct set of files # Note that each of the following tests use a distinct set of files
# subtest('stow a simple tree minimally', sub {
# stow a simple tree minimally plan tests => 2;
# my $stow = new_Stow(dir => '../stow');
$stow = new_Stow(dir => '../stow');
make_path('../stow/pkg1/bin1'); make_path('../stow/pkg1/bin1');
make_file('../stow/pkg1/bin1/file1'); make_file('../stow/pkg1/bin1/file1');
$stow->plan_stow('pkg1'); $stow->plan_stow('pkg1');
$stow->process_tasks(); $stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow'); is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink('bin1'),
'../stow/pkg1/bin1',
=> 'minimal stow of a simple tree'
);
#
# stow a simple tree into an existing directory
#
$stow = new_Stow();
make_path('../stow/pkg2/lib2');
make_file('../stow/pkg2/lib2/file2');
make_path('lib2');
$stow->plan_stow('pkg2');
$stow->process_tasks();
is(
readlink('lib2/file2'),
'../../stow/pkg2/lib2/file2',
=> 'stow simple tree to existing directory'
);
#
# unfold existing tree
#
$stow = new_Stow();
make_path('../stow/pkg3a/bin3');
make_file('../stow/pkg3a/bin3/file3a');
make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
make_path('../stow/pkg3b/bin3');
make_file('../stow/pkg3b/bin3/file3b');
$stow->plan_stow('pkg3b');
$stow->process_tasks();
ok(
-d 'bin3' &&
readlink('bin3/file3a') eq '../../stow/pkg3a/bin3/file3a' &&
readlink('bin3/file3b') eq '../../stow/pkg3b/bin3/file3b'
=> 'target already has 1 stowed package'
);
#
# Link to a new dir 'bin4' conflicts with existing non-dir so can't
# unfold
#
$stow = new_Stow();
make_file('bin4'); # this is a file but named like a directory
make_path('../stow/pkg4/bin4');
make_file('../stow/pkg4/bin4/file4');
$stow->plan_stow('pkg4');
%conflicts = $stow->get_conflicts();
ok(
$stow->get_conflict_count == 1 &&
$conflicts{stow}{pkg4}[0] =~
qr/existing target is neither a link nor a directory/
=> 'link to new dir bin4 conflicts with existing non-directory'
);
#
# Link to a new dir 'bin4a' conflicts with existing non-dir so can't
# unfold even with --adopt
#
#$stow = new_Stow(adopt => 1);
$stow = new_Stow();
make_file('bin4a'); # this is a file but named like a directory
make_path('../stow/pkg4a/bin4a');
make_file('../stow/pkg4a/bin4a/file4a');
$stow->plan_stow('pkg4a');
%conflicts = $stow->get_conflicts();
ok(
$stow->get_conflict_count == 1 &&
$conflicts{stow}{pkg4a}[0] =~
qr/existing target is neither a link nor a directory/
=> 'link to new dir bin4a conflicts with existing non-directory'
);
#
# Link to files 'file4b' and 'bin4b' conflict with existing files
# without --adopt
#
$stow = new_Stow();
# Populate target
make_file('file4b', 'file4b - version originally in target');
make_path ('bin4b');
make_file('bin4b/file4b', 'bin4b/file4b - version originally in target');
# Populate
make_path ('../stow/pkg4b/bin4b');
make_file('../stow/pkg4b/file4b', 'file4b - version originally in stow package');
make_file('../stow/pkg4b/bin4b/file4b', 'bin4b/file4b - version originally in stow package');
$stow->plan_stow('pkg4b');
%conflicts = $stow->get_conflicts();
is($stow->get_conflict_count, 2 => 'conflict per file');
for my $i (0, 1) {
like(
$conflicts{stow}{pkg4b}[$i],
qr/existing target is neither a link nor a directory/
=> 'link to file4b conflicts with existing non-directory'
);
}
#
# Link to files 'file4b' and 'bin4b' do not conflict with existing
# files when --adopt is given
#
$stow = new_Stow(adopt => 1);
# Populate target
make_file('file4c', "file4c - version originally in target\n");
make_path ('bin4c');
make_file('bin4c/file4c', "bin4c/file4c - version originally in target\n");
# Populate
make_path ('../stow/pkg4c/bin4c');
make_file('../stow/pkg4c/file4c', "file4c - version originally in stow package\n");
make_file('../stow/pkg4c/bin4c/file4c', "bin4c/file4c - version originally in stow package\n");
$stow->plan_stow('pkg4c');
is($stow->get_conflict_count, 0 => 'no conflicts with --adopt');
is($stow->get_tasks, 4 => 'two tasks per file');
$stow->process_tasks();
for my $file ('file4c', 'bin4c/file4c') {
ok(-l $file, "$file turned into a symlink");
is( is(
readlink $file, readlink('bin1'),
(index($file, '/') == -1 ? '' : '../' ) '../stow/pkg1/bin1',
. "../stow/pkg4c/$file" => "$file points to right place" => 'minimal stow of a simple tree'
); );
is(cat_file($file), "$file - version originally in target\n" => "$file has right contents"); });
}
subtest('stow a simple tree into an existing directory', sub {
plan tests => 1;
my $stow = new_Stow();
# make_path('../stow/pkg2/lib2');
# Target already exists but is not owned by stow make_file('../stow/pkg2/lib2/file2');
# make_path('lib2');
$stow = new_Stow();
make_path('bin5'); $stow->plan_stow('pkg2');
make_invalid_link('bin5/file5','../../empty'); $stow->process_tasks();
make_path('../stow/pkg5/bin5/file5'); is(
readlink('lib2/file2'),
'../../stow/pkg2/lib2/file2',
=> 'stow simple tree to existing directory'
);
});
$stow->plan_stow('pkg5'); subtest('unfold existing tree', sub {
%conflicts = $stow->get_conflicts(); plan tests => 3;
like( my $stow = new_Stow();
$conflicts{stow}{pkg5}[-1],
qr/not owned by stow/
=> 'target already exists but is not owned by stow'
);
# make_path('../stow/pkg3a/bin3');
# Replace existing but invalid target make_file('../stow/pkg3a/bin3/file3a');
# make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
$stow = new_Stow();
make_invalid_link('file6','../stow/path-does-not-exist'); make_path('../stow/pkg3b/bin3');
make_path('../stow/pkg6'); make_file('../stow/pkg3b/bin3/file3b');
make_file('../stow/pkg6/file6');
$stow->plan_stow('pkg6'); $stow->plan_stow('pkg3b');
$stow->process_tasks(); $stow->process_tasks();
is( ok(-d 'bin3');
readlink('file6'), is(readlink('bin3/file3a'), '../../stow/pkg3a/bin3/file3a');
'../stow/pkg6/file6' is(readlink('bin3/file3b'), '../../stow/pkg3b/bin3/file3b'
=> 'replace existing but invalid target' => 'target already has 1 stowed package');
); });
# subtest("Link to a new dir 'bin4' conflicts with existing non-dir so can't unfold", sub {
# Target already exists, is owned by stow, but points to a non-directory plan tests => 2;
# (can't unfold) my $stow = new_Stow();
#
$stow = new_Stow();
#set_debug_level(4);
make_path('bin7'); make_file('bin4'); # this is a file but named like a directory
make_path('../stow/pkg7a/bin7'); make_path('../stow/pkg4/bin4');
make_file('../stow/pkg7a/bin7/node7'); make_file('../stow/pkg4/bin4/file4');
make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
make_path('../stow/pkg7b/bin7/node7');
make_file('../stow/pkg7b/bin7/node7/file7');
$stow->plan_stow('pkg7b'); $stow->plan_stow('pkg4');
%conflicts = $stow->get_conflicts(); %conflicts = $stow->get_conflicts();
like( is($stow->get_conflict_count, 1);
$conflicts{stow}{pkg7b}[-1], ok($conflicts{stow}{pkg4}[0] =~
qr/existing target is stowed to a different package/ qr/existing target is neither a link nor a directory/
=> 'link to new dir conflicts with existing stowed non-directory' => 'link to new dir bin4 conflicts with existing non-directory'
); );
});
# subtest("Link to a new dir 'bin4a' conflicts with existing non-dir " .
# stowing directories named 0 "so can't unfold even with --adopt", sub {
# plan tests => 2;
$stow = new_Stow(); #my $stow = new_Stow(adopt => 1);
my $stow = new_Stow();
make_path('../stow/pkg8a/0'); make_file('bin4a'); # this is a file but named like a directory
make_file('../stow/pkg8a/0/file8a'); make_path('../stow/pkg4a/bin4a');
make_link('0' => '../stow/pkg8a/0'); # emulate stow make_file('../stow/pkg4a/bin4a/file4a');
make_path('../stow/pkg8b/0'); $stow->plan_stow('pkg4a');
make_file('../stow/pkg8b/0/file8b'); %conflicts = $stow->get_conflicts();
is($stow->get_conflict_count, 1);
like($conflicts{stow}{pkg4a}[0],
qr/existing target is neither a link nor a directory/
=> 'link to new dir bin4a conflicts with existing non-directory'
);
});
$stow->plan_stow('pkg8b'); subtest("Link to files 'file4b' and 'bin4b' conflict with existing files", sub {
$stow->process_tasks(); plan tests => 3;
ok( my $stow = new_Stow();
$stow->get_conflict_count == 0 &&
-d '0' &&
readlink('0/file8a') eq '../../stow/pkg8a/0/file8a' &&
readlink('0/file8b') eq '../../stow/pkg8b/0/file8b'
=> 'stowing directories named 0'
);
# # Populate target
# overriding already stowed documentation make_file('file4b', 'file4b - version originally in target');
# make_path ('bin4b');
$stow = new_Stow(override => ['man9', 'info9']); make_file('bin4b/file4b', 'bin4b/file4b - version originally in target');
make_path('../stow/pkg9a/man9/man1'); # Populate
make_file('../stow/pkg9a/man9/man1/file9.1'); make_path ('../stow/pkg4b/bin4b');
make_path('man9/man1'); make_file('../stow/pkg4b/file4b', 'file4b - version originally in stow package');
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow make_file('../stow/pkg4b/bin4b/file4b', 'bin4b/file4b - version originally in stow package');
make_path('../stow/pkg9b/man9/man1'); $stow->plan_stow('pkg4b');
make_file('../stow/pkg9b/man9/man1/file9.1'); %conflicts = $stow->get_conflicts();
is($stow->get_conflict_count, 2 => 'conflict per file');
for my $i (0, 1) {
like(
$conflicts{stow}{pkg4b}[$i],
qr/existing target is neither a link nor a directory/
=> 'link to file4b conflicts with existing non-directory'
);
}
});
$stow->plan_stow('pkg9b'); subtest("Link to files 'file4b' and 'bin4b' do not conflict with existing", sub {
$stow->process_tasks(); plan tests => 8;
ok( my $stow = new_Stow(adopt => 1);
$stow->get_conflict_count == 0 &&
readlink('man9/man1/file9.1') eq '../../../stow/pkg9b/man9/man1/file9.1'
=> 'overriding existing documentation files'
);
# # Populate target
# deferring to already stowed documentation make_file('file4c', "file4c - version originally in target\n");
# make_path ('bin4c');
$stow = new_Stow(defer => ['man10', 'info10']); make_file('bin4c/file4c', "bin4c/file4c - version originally in target\n");
make_path('../stow/pkg10a/man10/man1'); # Populate
make_file('../stow/pkg10a/man10/man1/file10.1'); make_path ('../stow/pkg4c/bin4c');
make_path('man10/man1'); make_file('../stow/pkg4c/file4c', "file4c - version originally in stow package\n");
make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1'); # emulate stow make_file('../stow/pkg4c/bin4c/file4c', "bin4c/file4c - version originally in stow package\n");
make_path('../stow/pkg10b/man10/man1'); $stow->plan_stow('pkg4c');
make_file('../stow/pkg10b/man10/man1/file10.1'); is($stow->get_conflict_count, 0 => 'no conflicts with --adopt');
is($stow->get_tasks, 4 => 'two tasks per file');
$stow->process_tasks();
for my $file ('file4c', 'bin4c/file4c') {
ok(-l $file, "$file turned into a symlink");
is(
readlink $file,
(index($file, '/') == -1 ? '' : '../' )
. "../stow/pkg4c/$file" => "$file points to right place"
);
is(cat_file($file), "$file - version originally in target\n" => "$file has right contents");
}
$stow->plan_stow('pkg10b'); });
is($stow->get_tasks, 0, 'no tasks to process');
ok(
$stow->get_conflict_count == 0 &&
readlink('man10/man1/file10.1') eq '../../../stow/pkg10a/man10/man1/file10.1'
=> 'defer to existing documentation files'
);
# subtest("Target already exists but is not owned by stow", sub {
# Ignore temp files plan tests => 1;
# my $stow = new_Stow();
$stow = new_Stow(ignore => ['~', '\.#.*']);
make_path('../stow/pkg11/man11/man1'); make_path('bin5');
make_file('../stow/pkg11/man11/man1/file11.1'); make_invalid_link('bin5/file5','../../empty');
make_file('../stow/pkg11/man11/man1/file11.1~'); make_path('../stow/pkg5/bin5/file5');
make_file('../stow/pkg11/man11/man1/.#file11.1');
make_path('man11/man1');
$stow->plan_stow('pkg11'); $stow->plan_stow('pkg5');
$stow->process_tasks(); %conflicts = $stow->get_conflicts();
ok( like(
$stow->get_conflict_count == 0 && $conflicts{stow}{pkg5}[-1],
readlink('man11/man1/file11.1') eq '../../../stow/pkg11/man11/man1/file11.1' && qr/not owned by stow/
!-e 'man11/man1/file11.1~' && => 'target already exists but is not owned by stow'
!-e 'man11/man1/.#file11.1' );
=> 'ignore temp files' });
);
# subtest("Replace existing but invalid target", sub {
# stowing links library files plan tests => 1;
# my $stow = new_Stow();
$stow = new_Stow();
make_path('../stow/pkg12/lib12/'); make_invalid_link('file6','../stow/path-does-not-exist');
make_file('../stow/pkg12/lib12/lib.so.1'); make_path('../stow/pkg6');
make_link('../stow/pkg12/lib12/lib.so', 'lib.so.1'); make_file('../stow/pkg6/file6');
make_path('lib12/'); $stow->plan_stow('pkg6');
$stow->process_tasks();
is(
readlink('file6'),
'../stow/pkg6/file6'
=> 'replace existing but invalid target'
);
});
$stow->plan_stow('pkg12'); subtest("Target already exists, is owned by stow, but points to a non-directory", sub {
$stow->process_tasks(); plan tests => 1;
ok( my $stow = new_Stow();
$stow->get_conflict_count == 0 && #set_debug_level(4);
readlink('lib12/lib.so.1') eq '../../stow/pkg12/lib12/lib.so.1' &&
readlink('lib12/lib.so' ) eq '../../stow/pkg12/lib12/lib.so'
=> 'stow links to libraries'
);
# make_path('bin7');
# unfolding to stow links to library files make_path('../stow/pkg7a/bin7');
# make_file('../stow/pkg7a/bin7/node7');
$stow = new_Stow(); make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
make_path('../stow/pkg7b/bin7/node7');
make_file('../stow/pkg7b/bin7/node7/file7');
make_path('../stow/pkg13a/lib13/'); $stow->plan_stow('pkg7b');
make_file('../stow/pkg13a/lib13/liba.so.1'); %conflicts = $stow->get_conflicts();
make_link('../stow/pkg13a/lib13/liba.so', 'liba.so.1'); like(
make_link('lib13','../stow/pkg13a/lib13'); $conflicts{stow}{pkg7b}[-1],
qr/existing target is stowed to a different package/
=> 'link to new dir conflicts with existing stowed non-directory'
);
});
make_path('../stow/pkg13b/lib13/'); subtest("stowing directories named 0", sub {
make_file('../stow/pkg13b/lib13/libb.so.1'); plan tests => 4;
make_link('../stow/pkg13b/lib13/libb.so', 'libb.so.1'); my $stow = new_Stow();
$stow->plan_stow('pkg13b'); make_path('../stow/pkg8a/0');
$stow->process_tasks(); make_file('../stow/pkg8a/0/file8a');
ok( make_link('0' => '../stow/pkg8a/0'); # emulate stow
$stow->get_conflict_count == 0 &&
readlink('lib13/liba.so.1') eq '../../stow/pkg13a/lib13/liba.so.1' &&
readlink('lib13/liba.so' ) eq '../../stow/pkg13a/lib13/liba.so' &&
readlink('lib13/libb.so.1') eq '../../stow/pkg13b/lib13/libb.so.1' &&
readlink('lib13/libb.so' ) eq '../../stow/pkg13b/lib13/libb.so'
=> 'unfolding to stow links to libraries'
);
# make_path('../stow/pkg8b/0');
# stowing to stow dir should fail make_file('../stow/pkg8b/0/file8b');
#
make_path('stow');
$stow = new_Stow(dir => 'stow');
make_path('stow/pkg14/stow/pkg15'); $stow->plan_stow('pkg8b');
make_file('stow/pkg14/stow/pkg15/node15'); $stow->process_tasks();
is($stow->get_conflict_count, 0);
ok(-d '0');
is(readlink('0/file8a'), '../../stow/pkg8a/0/file8a');
is(readlink('0/file8b'), '../../stow/pkg8b/0/file8b'
=> 'stowing directories named 0'
);
});
capture_stderr(); subtest("overriding already stowed documentation", sub {
$stow->plan_stow('pkg14'); plan tests => 2;
is($stow->get_tasks, 0, 'no tasks to process'); my $stow = new_Stow(override => ['man9', 'info9']);
ok(
$stow->get_conflict_count == 0 &&
! -l 'stow/pkg15'
=> "stowing to stow dir should fail"
);
like($stderr,
qr/WARNING: skipping target which was current stow directory stow/
=> "stowing to stow dir should give warning");
uncapture_stderr();
# make_path('../stow/pkg9a/man9/man1');
# stow a simple tree minimally when cwd isn't target make_file('../stow/pkg9a/man9/man1/file9.1');
# make_path('man9/man1');
cd('../..'); make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
make_path("$TEST_DIR/stow/pkg16/bin16"); make_path('../stow/pkg9b/man9/man1');
make_file("$TEST_DIR/stow/pkg16/bin16/file16"); make_file('../stow/pkg9b/man9/man1/file9.1');
$stow->plan_stow('pkg16'); $stow->plan_stow('pkg9b');
$stow->process_tasks(); $stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow'); is($stow->get_conflict_count, 0);
is( is(readlink('man9/man1/file9.1'), '../../../stow/pkg9b/man9/man1/file9.1'
readlink("$TEST_DIR/target/bin16"), => 'overriding existing documentation files'
'../stow/pkg16/bin16', );
=> "minimal stow of a simple tree when cwd isn't target" });
);
# subtest("deferring to already stowed documentation", sub {
# stow a simple tree minimally to absolute stow dir when cwd isn't plan tests => 3;
# target my $stow = new_Stow(defer => ['man10', 'info10']);
#
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => "$TEST_DIR/target");
make_path("$TEST_DIR/stow/pkg17/bin17"); make_path('../stow/pkg10a/man10/man1');
make_file("$TEST_DIR/stow/pkg17/bin17/file17"); make_file('../stow/pkg10a/man10/man1/file10.1');
make_path('man10/man1');
make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1'); # emulate stow
$stow->plan_stow('pkg17'); make_path('../stow/pkg10b/man10/man1');
$stow->process_tasks(); make_file('../stow/pkg10b/man10/man1/file10.1');
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink("$TEST_DIR/target/bin17"),
'../stow/pkg17/bin17',
=> "minimal stow of a simple tree with absolute stow dir"
);
# $stow->plan_stow('pkg10b');
# stow a simple tree minimally with absolute stow AND target dirs when is($stow->get_tasks, 0, 'no tasks to process');
# cwd isn't target is($stow->get_conflict_count, 0);
# is(readlink('man10/man1/file10.1'), '../../../stow/pkg10a/man10/man1/file10.1'
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"), => 'defer to existing documentation files'
target => canon_path("$TEST_DIR/target")); );
});
make_path("$TEST_DIR/stow/pkg18/bin18"); subtest("Ignore temp files", sub {
make_file("$TEST_DIR/stow/pkg18/bin18/file18"); plan tests => 4;
my $stow = new_Stow(ignore => ['~', '\.#.*']);
$stow->plan_stow('pkg18'); make_path('../stow/pkg11/man11/man1');
$stow->process_tasks(); make_file('../stow/pkg11/man11/man1/file11.1');
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow'); make_file('../stow/pkg11/man11/man1/file11.1~');
is( make_file('../stow/pkg11/man11/man1/.#file11.1');
readlink("$TEST_DIR/target/bin18"), make_path('man11/man1');
'../stow/pkg18/bin18',
=> "minimal stow of a simple tree with absolute stow and target dirs"
);
# $stow->plan_stow('pkg11');
# stow a tree with no-folding enabled - $stow->process_tasks();
# no new folded directories should be created, and existing is($stow->get_conflict_count, 0);
# folded directories should be split open (unfolded) where is(readlink('man11/man1/file11.1'), '../../../stow/pkg11/man11/man1/file11.1');
# (and only where) necessary ok(!-e 'man11/man1/file11.1~');
# ok(!-e 'man11/man1/.#file11.1'
cd("$TEST_DIR/target"); => 'ignore temp files'
);
});
sub create_pkg { subtest("stowing links library files", sub {
my ($id, $pkg) = @_; plan tests => 3;
my $stow = new_Stow();
my $stow_pkg = "../stow/$id-$pkg"; make_path('../stow/pkg12/lib12/');
make_path ($stow_pkg); make_file('../stow/pkg12/lib12/lib.so.1');
make_file("$stow_pkg/$id-file-$pkg"); make_link('../stow/pkg12/lib12/lib.so', 'lib.so.1');
# create a shallow hierarchy specific to this package which isn't make_path('lib12/');
# yet stowed
make_path ("$stow_pkg/$id-$pkg-only-new");
make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
# create a deeper hierarchy specific to this package which isn't $stow->plan_stow('pkg12');
# yet stowed $stow->process_tasks();
make_path ("$stow_pkg/$id-$pkg-only-new2/subdir"); is($stow->get_conflict_count, 0);
make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg"); is(readlink('lib12/lib.so.1'), '../../stow/pkg12/lib12/lib.so.1');
make_link("$stow_pkg/$id-$pkg-only-new2/current", "subdir"); is(readlink('lib12/lib.so'), '../../stow/pkg12/lib12/lib.so'
=> 'stow links to libraries'
);
});
# create a hierarchy specific to this package which is already subtest("unfolding to stow links to library files", sub {
# stowed via a folded tree plan tests => 5;
make_path ("$stow_pkg/$id-$pkg-only-old"); my $stow = new_Stow();
make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
# create a shared hierarchy which this package uses make_path('../stow/pkg13a/lib13/');
make_path ("$stow_pkg/$id-shared"); make_file('../stow/pkg13a/lib13/liba.so.1');
make_file("$stow_pkg/$id-shared/$id-file-$pkg"); make_link('../stow/pkg13a/lib13/liba.so', 'liba.so.1');
make_link('lib13','../stow/pkg13a/lib13');
# create a partially shared hierarchy which this package uses make_path('../stow/pkg13b/lib13/');
make_path ("$stow_pkg/$id-shared2/subdir-$pkg"); make_file('../stow/pkg13b/lib13/libb.so.1');
make_file("$stow_pkg/$id-shared2/$id-file-$pkg"); make_link('../stow/pkg13b/lib13/libb.so', 'libb.so.1');
make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
}
foreach my $pkg (qw{a b}) { $stow->plan_stow('pkg13b');
create_pkg('no-folding', $pkg); $stow->process_tasks();
} is($stow->get_conflict_count, 0);
is(readlink('lib13/liba.so.1'), '../../stow/pkg13a/lib13/liba.so.1');
is(readlink('lib13/liba.so' ), '../../stow/pkg13a/lib13/liba.so');
is(readlink('lib13/libb.so.1'), '../../stow/pkg13b/lib13/libb.so.1');
is(readlink('lib13/libb.so' ), '../../stow/pkg13b/lib13/libb.so'
=> 'unfolding to stow links to libraries'
);
});
$stow = new_Stow('no-folding' => 1); subtest("stowing to stow dir should fail", sub {
$stow->plan_stow('no-folding-a'); plan tests => 4;
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding'); make_path('stow');
my @tasks = $stow->get_tasks; $stow = new_Stow(dir => 'stow');
use Data::Dumper;
is(scalar(@tasks), 13 => "6 dirs, 7 links") || warn Dumper(\@tasks);
$stow->process_tasks();
sub check_no_folding { make_path('stow/pkg14/stow/pkg15');
my ($pkg) = @_; make_file('stow/pkg14/stow/pkg15/node15');
my $stow_pkg = "../stow/no-folding-$pkg";
is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
# check existing folded tree is untouched capture_stderr();
is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old"); $stow->plan_stow('pkg14');
is($stow->get_tasks, 0, 'no tasks to process');
is($stow->get_conflict_count, 0);
ok(
! -l 'stow/pkg15'
=> "stowing to stow dir should fail"
);
like($stderr,
qr/WARNING: skipping target which was current stow directory stow/
=> "stowing to stow dir should give warning");
uncapture_stderr();
});
# check newly stowed shallow tree is not folded subtest("stow a simple tree minimally when cwd isn't target", sub {
is_dir_not_symlink("no-folding-$pkg-only-new"); plan tests => 2;
is_link("no-folding-$pkg-only-new/no-folding-file-$pkg", cd('../..');
"../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg"); $stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
# check newly stowed deeper tree is not folded make_path("$TEST_DIR/stow/pkg16/bin16");
is_dir_not_symlink("no-folding-$pkg-only-new2"); make_file("$TEST_DIR/stow/pkg16/bin16/file16");
is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
"../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
is_link("no-folding-$pkg-only-new2/current",
"../$stow_pkg/no-folding-$pkg-only-new2/current");
# check shared tree is not folded. first time round this will be $stow->plan_stow('pkg16');
# newly stowed. $stow->process_tasks();
is_dir_not_symlink('no-folding-shared'); is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is_link("no-folding-shared/no-folding-file-$pkg", is(
"../$stow_pkg/no-folding-shared/no-folding-file-$pkg"); readlink("$TEST_DIR/target/bin16"),
'../stow/pkg16/bin16',
=> "minimal stow of a simple tree when cwd isn't target"
);
});
# check partially shared tree is not folded. first time round this subtest("stow a simple tree minimally to absolute stow dir when cwd isn't", sub {
# will be newly stowed. plan tests => 2;
is_dir_not_symlink('no-folding-shared2'); my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
is_link("no-folding-shared2/no-folding-file-$pkg", target => "$TEST_DIR/target");
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
}
check_no_folding('a'); make_path("$TEST_DIR/stow/pkg17/bin17");
make_file("$TEST_DIR/stow/pkg17/bin17/file17");
$stow = new_Stow('no-folding' => 1); $stow->plan_stow('pkg17');
$stow->plan_stow('no-folding-b'); $stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding'); is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
@tasks = $stow->get_tasks; is(
is(scalar(@tasks), 11 => '4 dirs, 7 links') || warn Dumper(\@tasks); readlink("$TEST_DIR/target/bin17"),
$stow->process_tasks(); '../stow/pkg17/bin17',
=> "minimal stow of a simple tree with absolute stow dir"
);
});
check_no_folding('a'); subtest("stow a simple tree minimally with absolute stow AND target dirs when", sub {
check_no_folding('b'); plan tests => 2;
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
target => canon_path("$TEST_DIR/target"));
make_path("$TEST_DIR/stow/pkg18/bin18");
make_file("$TEST_DIR/stow/pkg18/bin18/file18");
$stow->plan_stow('pkg18');
$stow->process_tasks();
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is(
readlink("$TEST_DIR/target/bin18"),
'../stow/pkg18/bin18',
=> "minimal stow of a simple tree with absolute stow and target dirs"
);
});
subtest("stow a tree with no-folding enabled", sub {
plan tests => 82;
# folded directories should be split open (unfolded) where
# (and only where) necessary
#
cd("$TEST_DIR/target");
sub create_pkg {
my ($id, $pkg) = @_;
my $stow_pkg = "../stow/$id-$pkg";
make_path ($stow_pkg);
make_file("$stow_pkg/$id-file-$pkg");
# create a shallow hierarchy specific to this package which isn't
# yet stowed
make_path ("$stow_pkg/$id-$pkg-only-new");
make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
# create a deeper hierarchy specific to this package which isn't
# yet stowed
make_path ("$stow_pkg/$id-$pkg-only-new2/subdir");
make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg");
make_link("$stow_pkg/$id-$pkg-only-new2/current", "subdir");
# create a hierarchy specific to this package which is already
# stowed via a folded tree
make_path ("$stow_pkg/$id-$pkg-only-old");
make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
# create a shared hierarchy which this package uses
make_path ("$stow_pkg/$id-shared");
make_file("$stow_pkg/$id-shared/$id-file-$pkg");
# create a partially shared hierarchy which this package uses
make_path ("$stow_pkg/$id-shared2/subdir-$pkg");
make_file("$stow_pkg/$id-shared2/$id-file-$pkg");
make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
}
foreach my $pkg (qw{a b}) {
create_pkg('no-folding', $pkg);
}
$stow = new_Stow('no-folding' => 1);
$stow->plan_stow('no-folding-a');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
my @tasks = $stow->get_tasks;
use Data::Dumper;
is(scalar(@tasks), 13 => "6 dirs, 7 links") || warn Dumper(\@tasks);
$stow->process_tasks();
sub check_no_folding {
my ($pkg) = @_;
my $stow_pkg = "../stow/no-folding-$pkg";
is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
# check existing folded tree is untouched
is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old");
# check newly stowed shallow tree is not folded
is_dir_not_symlink("no-folding-$pkg-only-new");
is_link("no-folding-$pkg-only-new/no-folding-file-$pkg",
"../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg");
# check newly stowed deeper tree is not folded
is_dir_not_symlink("no-folding-$pkg-only-new2");
is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
"../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
is_link("no-folding-$pkg-only-new2/current",
"../$stow_pkg/no-folding-$pkg-only-new2/current");
# check shared tree is not folded. first time round this will be
# newly stowed.
is_dir_not_symlink('no-folding-shared');
is_link("no-folding-shared/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared/no-folding-file-$pkg");
# check partially shared tree is not folded. first time round this
# will be newly stowed.
is_dir_not_symlink('no-folding-shared2');
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
}
check_no_folding('a');
$stow = new_Stow('no-folding' => 1);
$stow->plan_stow('no-folding-b');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
@tasks = $stow->get_tasks;
is(scalar(@tasks), 11 => '4 dirs, 7 links') || warn Dumper(\@tasks);
$stow->process_tasks();
check_no_folding('a');
check_no_folding('b');
});