merge unstow_orig.t into unstow.t and fix unstowing logic
There was a ton of duplication which is not maintainable, so refactor everything into a single test which still covers the differences. This in turn revealed some issues in the unstowing logic: - We shouldn't conflict if we find a file which isn't a link or a directory; we can just skip over it. - Unstowing with `--dotfiles` was using the wrong variable to obtain the package path, and as a result having to perform an unnecessary call to `adjust_dotfile()`. So fix those at the same time.
This commit is contained in:
Adam Spiers
parent
001b287b1b
commit
06fdfc185f
9 changed files with 269 additions and 589 deletions
2
.gitignore
vendored
2
.gitignore
vendored
|
|
@ -10,7 +10,7 @@
|
|||
/doc/stow.info
|
||||
/doc/version.texi
|
||||
/playground/
|
||||
tmp-testing-trees/
|
||||
tmp-testing-trees*/
|
||||
_build/
|
||||
autom4te.cache/
|
||||
blib/
|
||||
|
|
|
|||
1
MANIFEST
1
MANIFEST
|
|
@ -50,7 +50,6 @@ t/stow.t
|
|||
t/rc_options.t
|
||||
t/testutil.pm
|
||||
t/unstow.t
|
||||
t/unstow_orig.t
|
||||
tools/get-version
|
||||
THANKS
|
||||
TODO
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@
|
|||
^doc/HOWTO-RELEASE$
|
||||
|
||||
# Avoid test files
|
||||
tmp-testing-trees
|
||||
tmp-testing-trees*
|
||||
^.coveralls.yml
|
||||
^.github/workflows/
|
||||
^.travis.yml
|
||||
|
|
|
|||
|
|
@ -51,7 +51,7 @@ DEFAULT_IGNORE_LIST = $(srcdir)/default-ignore-list
|
|||
doc_deps = $(info_TEXINFOS) doc/version.texi $(DEFAULT_IGNORE_LIST)
|
||||
|
||||
TESTS_DIR = $(srcdir)/t
|
||||
TESTS_OUT = tmp-testing-trees
|
||||
TESTS_OUT = tmp-testing-trees tmp-testing-trees-compat
|
||||
TESTS_ENVIRONMENT = $(PERL) -Ibin -Ilib -I$(TESTS_DIR)
|
||||
|
||||
# This is a kind of hack; TESTS needs to be set to ensure that the
|
||||
|
|
|
|||
|
|
@ -787,17 +787,15 @@ sub unstow_node {
|
|||
my $self = shift;
|
||||
my ($package, $target_subpath, $source) = @_;
|
||||
|
||||
my $pkg_path_from_cwd = join_paths($self->{stow_path}, $package, $target_subpath);
|
||||
|
||||
debug(3, 1, "Unstowing $pkg_path_from_cwd");
|
||||
debug(3, 1, "Unstowing $source");
|
||||
debug(4, 2, "target is $target_subpath");
|
||||
|
||||
# Does the target exist?
|
||||
if ($self->is_a_link($target_subpath)) {
|
||||
$self->unstow_link_node($package, $target_subpath, $pkg_path_from_cwd);
|
||||
$self->unstow_link_node($package, $target_subpath, $source);
|
||||
}
|
||||
elsif ($self->{compat} && -d $target_subpath) {
|
||||
$self->unstow_contents($package, $target_subpath, $pkg_path_from_cwd);
|
||||
elsif (-d $target_subpath) {
|
||||
$self->unstow_contents($package, $target_subpath, $source);
|
||||
|
||||
# This action may have made the parent directory foldable
|
||||
if (my $parent_in_pkg = $self->foldable($target_subpath)) {
|
||||
|
|
@ -805,16 +803,7 @@ sub unstow_node {
|
|||
}
|
||||
}
|
||||
elsif (-e $target_subpath) {
|
||||
if ($self->{compat}) {
|
||||
$self->conflict(
|
||||
'unstow',
|
||||
$package,
|
||||
"existing target is neither a link nor a directory: $target_subpath",
|
||||
);
|
||||
}
|
||||
else {
|
||||
$self->unstow_existing_node($package, $target_subpath, $source);
|
||||
}
|
||||
debug(2, 1, "$target_subpath doesn't need to be unstowed");
|
||||
}
|
||||
else {
|
||||
debug(2, 1, "$target_subpath did not exist to be unstowed");
|
||||
|
|
@ -859,7 +848,12 @@ sub unstow_link_node {
|
|||
|
||||
# Does the existing $target_subpath actually point to anything?
|
||||
if (-e $existing_pkg_path_from_cwd) {
|
||||
$self->unstow_valid_link($pkg_path_from_cwd, $target_subpath, $existing_pkg_path_from_cwd);
|
||||
if ($existing_pkg_path_from_cwd eq $pkg_path_from_cwd) {
|
||||
$self->do_unlink($target_subpath);
|
||||
}
|
||||
else {
|
||||
debug(5, 3, "Ignoring link $target_subpath => $link_dest");
|
||||
}
|
||||
}
|
||||
else {
|
||||
debug(2, 0, "--- removing invalid link into a stow directory: $pkg_path_from_cwd");
|
||||
|
|
@ -867,61 +861,6 @@ sub unstow_link_node {
|
|||
}
|
||||
}
|
||||
|
||||
sub unstow_valid_link {
|
||||
my $self = shift;
|
||||
my ($pkg_path_from_cwd, $target_subpath, $existing_pkg_path_from_cwd) = @_;
|
||||
# Does link points to the right place?
|
||||
|
||||
# Adjust for dotfile if necessary.
|
||||
if ($self->{dotfiles}) {
|
||||
$existing_pkg_path_from_cwd = adjust_dotfile($existing_pkg_path_from_cwd);
|
||||
}
|
||||
|
||||
if ($existing_pkg_path_from_cwd eq $pkg_path_from_cwd) {
|
||||
$self->do_unlink($target_subpath);
|
||||
}
|
||||
|
||||
# FIXME: we quietly ignore links that are stowed to a different
|
||||
# package.
|
||||
|
||||
#elsif (defer($target_subpath)) {
|
||||
# debug(2, 0, "--- deferring to installation of: $target_subpath");
|
||||
#}
|
||||
#elsif ($self->override($target_subpath)) {
|
||||
# debug(2, 0, "--- overriding installation of: $target_subpath");
|
||||
# $self->do_unlink($target_subpath);
|
||||
#}
|
||||
#else {
|
||||
# $self->conflict(
|
||||
# 'unstow',
|
||||
# $package,
|
||||
# "existing target is stowed to a different package: "
|
||||
# . "$target_subpath => $existing_source"
|
||||
# );
|
||||
#}
|
||||
}
|
||||
|
||||
sub unstow_existing_node {
|
||||
my $self = shift;
|
||||
my ($package, $target_subpath, $source) = @_;
|
||||
debug(4, 2, "Evaluate existing node: $target_subpath");
|
||||
if (-d $target_subpath) {
|
||||
$self->unstow_contents($package, $target_subpath, $source);
|
||||
|
||||
# This action may have made the parent directory foldable
|
||||
if (my $parent_in_pkg = $self->foldable($target_subpath)) {
|
||||
$self->fold_tree($target_subpath, $parent_in_pkg);
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->conflict(
|
||||
'unstow',
|
||||
$package,
|
||||
"existing target is neither a link nor a directory: $target_subpath",
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
=head2 link_owned_by_package($target_subpath, $link_dest)
|
||||
|
||||
Determine whether the given link points to a member of a stowed
|
||||
|
|
|
|||
|
|
@ -187,7 +187,7 @@ subtest("simple unstow scenario", sub {
|
|||
$stow->plan_unstow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f '../stow/dotfiles/dot-bar');
|
||||
ok(-f '../stow/dotfiles/dot-bar', 'package file untouched');
|
||||
ok(! -e '.bar' => 'unstow a simple dotfile');
|
||||
});
|
||||
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ package testutil;
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw(croak);
|
||||
use Carp qw(confess croak);
|
||||
use File::Basename;
|
||||
use File::Path qw(make_path remove_tree);
|
||||
use File::Spec;
|
||||
|
|
@ -50,17 +50,21 @@ our $TEST_DIR = 'tmp-testing-trees';
|
|||
our $ABS_TEST_DIR = File::Spec->rel2abs('tmp-testing-trees');
|
||||
|
||||
sub init_test_dirs {
|
||||
my $test_dir = shift || $TEST_DIR;
|
||||
my $abs_test_dir = File::Spec->rel2abs($test_dir);
|
||||
|
||||
# Create a run_from/ subdirectory for tests which want to run
|
||||
# from a separate directory outside the Stow directory or
|
||||
# target directory.
|
||||
for my $dir ("target", "stow", "run_from") {
|
||||
my $path = "$TEST_DIR/$dir";
|
||||
my $path = "$test_dir/$dir";
|
||||
-d $path and remove_tree($path);
|
||||
make_path($path);
|
||||
}
|
||||
|
||||
# Don't let user's ~/.stow-global-ignore affect test results
|
||||
$ENV{HOME} = $ABS_TEST_DIR;
|
||||
$ENV{HOME} = $abs_test_dir;
|
||||
return $abs_test_dir;
|
||||
}
|
||||
|
||||
sub new_Stow {
|
||||
|
|
@ -70,7 +74,11 @@ sub new_Stow {
|
|||
$opts{dir} ||= '../stow';
|
||||
$opts{target} ||= '.';
|
||||
$opts{test_mode} = 1;
|
||||
return new Stow(%opts);
|
||||
my $stow = eval { new Stow(%opts) };
|
||||
if ($@) {
|
||||
confess "Error while trying to instantiate new Stow(%opts): $@";
|
||||
}
|
||||
return $stow;
|
||||
}
|
||||
|
||||
sub new_compat_Stow {
|
||||
|
|
|
|||
357
t/unstow.t
357
t/unstow.t
|
|
@ -22,21 +22,70 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 32;
|
||||
use File::Spec qw(make_path);
|
||||
use POSIX qw(getcwd);
|
||||
use Test::More tests => 49;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use testutil;
|
||||
use Stow::Util qw(canon_path);
|
||||
|
||||
init_test_dirs();
|
||||
cd("$TEST_DIR/target");
|
||||
my $repo = getcwd();
|
||||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
init_test_dirs($TEST_DIR);
|
||||
|
||||
subtest("unstow a simple tree minimally", sub {
|
||||
our $COMPAT_TEST_DIR = "${TEST_DIR}-compat";
|
||||
our $COMPAT_ABS_TEST_DIR = init_test_dirs($COMPAT_TEST_DIR);
|
||||
|
||||
sub init_stow2 {
|
||||
make_path('stow2'); # make our alternate stow dir a subdir of target
|
||||
make_file('stow2/.stow');
|
||||
}
|
||||
|
||||
# Run a subtest twice, with compat off then on, in parallel test trees.
|
||||
#
|
||||
# Params: $name[, $setup], $test_code
|
||||
#
|
||||
# $setup is an optional ref to an options hash to pass into the new
|
||||
# Stow() constructor, or a ref to a sub which performs setup before
|
||||
# the constructor gets called and then returns that options hash.
|
||||
sub subtests {
|
||||
my $name = shift;
|
||||
my $setup = @_ == 2 ? shift : {};
|
||||
my $code = shift;
|
||||
|
||||
$ENV{HOME} = $ABS_TEST_DIR;
|
||||
cd($repo);
|
||||
cd("$TEST_DIR/target");
|
||||
# cd first to allow setup to cd somewhere else.
|
||||
my $opts = ref($setup) eq 'HASH' ? $setup : $setup->($TEST_DIR);
|
||||
subtest($name, sub {
|
||||
make_path($opts->{dir}) if $opts->{dir};
|
||||
my $stow = new_Stow(%$opts);
|
||||
$code->($stow, $TEST_DIR);
|
||||
});
|
||||
|
||||
$ENV{HOME} = $COMPAT_ABS_TEST_DIR;
|
||||
cd($repo);
|
||||
cd("$COMPAT_TEST_DIR/target");
|
||||
# cd first to allow setup to cd somewhere else.
|
||||
$opts = ref $setup eq 'HASH' ? $setup : $setup->($COMPAT_TEST_DIR);
|
||||
subtest("$name (compat mode)", sub {
|
||||
make_path($opts->{dir}) if $opts->{dir};
|
||||
my $stow = new_compat_Stow(%$opts);
|
||||
$code->($stow, $COMPAT_TEST_DIR);
|
||||
});
|
||||
}
|
||||
|
||||
sub plan_tests {
|
||||
my ($stow, $count) = @_;
|
||||
plan tests => $stow->{compat} ? $count + 2 : $count;
|
||||
}
|
||||
|
||||
subtests("unstow a simple tree minimally", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow();
|
||||
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
|
|
@ -44,14 +93,14 @@ subtest("unstow a simple tree minimally", sub {
|
|||
|
||||
$stow->plan_unstow('pkg1');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f '../stow/pkg1/bin1/file1');
|
||||
ok(! -e 'bin1' => 'unstow a simple tree');
|
||||
});
|
||||
|
||||
subtest("unstow a simple tree from an existing directory", sub {
|
||||
subtests("unstow a simple tree from an existing directory", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow();
|
||||
|
||||
make_path('lib2');
|
||||
make_path('../stow/pkg2/lib2');
|
||||
|
|
@ -59,16 +108,16 @@ subtest("unstow a simple tree from an existing directory", sub {
|
|||
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
|
||||
$stow->plan_unstow('pkg2');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f '../stow/pkg2/lib2/file2');
|
||||
ok(-d 'lib2'
|
||||
=> 'unstow simple tree from a pre-existing directory'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("fold tree after unstowing", sub {
|
||||
subtests("fold tree after unstowing", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow();
|
||||
|
||||
make_path('bin3');
|
||||
|
||||
|
|
@ -81,16 +130,16 @@ subtest("fold tree after unstowing", sub {
|
|||
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
|
||||
$stow->plan_unstow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'bin3');
|
||||
is(readlink('bin3'), '../stow/pkg3a/bin3'
|
||||
=> 'fold tree after unstowing'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("existing link is owned by stow but is invalid so it gets removed anyway", sub {
|
||||
subtests("existing link is owned by stow but is invalid so it gets removed anyway", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow();
|
||||
|
||||
make_path('bin4');
|
||||
make_path('../stow/pkg4/bin4');
|
||||
|
|
@ -99,31 +148,57 @@ subtest("existing link is owned by stow but is invalid so it gets removed anyway
|
|||
|
||||
$stow->plan_unstow('pkg4');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(! -e 'bin4/file4'
|
||||
=> q(remove invalid link owned by stow)
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Existing link is not owned by stow", sub {
|
||||
plan tests => 1;
|
||||
plan tests => 2;
|
||||
$ENV{HOME} = $ABS_TEST_DIR;
|
||||
cd($repo);
|
||||
cd("$TEST_DIR/target");
|
||||
my $stow = new_Stow();
|
||||
|
||||
make_path('../stow/pkg5/bin5');
|
||||
make_invalid_link('bin5', '../not-stow');
|
||||
|
||||
$stow->plan_unstow('pkg5');
|
||||
my %conflicts = $stow->get_conflicts;
|
||||
like(
|
||||
$conflicts{unstow}{pkg5}[-1],
|
||||
qr(existing target is not owned by stow)
|
||||
=> q(existing link not owned by stow)
|
||||
is($stow->get_conflict_count, 1, 'conflict count');
|
||||
my %conflicts = $stow->get_conflicts();
|
||||
is_deeply(
|
||||
\%conflicts,
|
||||
{
|
||||
'unstow' => {
|
||||
'pkg5' => [
|
||||
'existing target is not owned by stow: bin5 => ../not-stow'
|
||||
]
|
||||
}
|
||||
}
|
||||
=> "existing link not owned by stow"
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Target already exists, is owned by stow, but points to a different package", sub {
|
||||
subtest("Existing link is not owned by stow (compat mode)", sub {
|
||||
plan tests => 2;
|
||||
$ENV{HOME} = $COMPAT_ABS_TEST_DIR;
|
||||
cd($repo);
|
||||
cd("$COMPAT_TEST_DIR/target");
|
||||
my $stow = new_compat_Stow();
|
||||
|
||||
make_path('../stow/pkg5/bin5');
|
||||
make_invalid_link('bin5', '../not-stow');
|
||||
|
||||
$stow->plan_unstow('pkg5');
|
||||
# Unlike the non-compat test above, this doesn't cause any conflicts.
|
||||
ok(-l 'bin5');
|
||||
is(readlink('bin5'), '../not-stow' => "existing link not owned by stow");
|
||||
});
|
||||
|
||||
subtests("Target already exists, is owned by stow, but points to a different package", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow();
|
||||
|
||||
make_path('bin6');
|
||||
make_path('../stow/pkg6a/bin6');
|
||||
|
|
@ -134,7 +209,7 @@ subtest("Target already exists, is owned by stow, but points to a different pack
|
|||
make_file('../stow/pkg6b/bin6/file6');
|
||||
|
||||
$stow->plan_unstow('pkg6b');
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'bin6/file6');
|
||||
is(
|
||||
readlink('bin6/file6'),
|
||||
|
|
@ -143,19 +218,29 @@ subtest("Target already exists, is owned by stow, but points to a different pack
|
|||
);
|
||||
});
|
||||
|
||||
subtest("Don't unlink anything under the stow directory", sub {
|
||||
plan tests => 4;
|
||||
make_path('stow'); # make out stow dir a subdir of target
|
||||
my $stow = new_Stow(dir => 'stow');
|
||||
subtests("Don't unlink anything under the stow directory",
|
||||
sub {
|
||||
make_path('stow');
|
||||
return { dir => 'stow' };
|
||||
# target dir defaults to parent of stow, which is target directory
|
||||
},
|
||||
sub {
|
||||
plan tests => 5;
|
||||
my ($stow) = @_;
|
||||
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
# Emulate stowing into ourself (bizarre corner case or accident):
|
||||
make_path('stow/pkg7a/stow/pkg7b');
|
||||
make_file('stow/pkg7a/stow/pkg7b/file7b');
|
||||
# Make a package be a link to a package of the same name inside another package.
|
||||
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
|
||||
|
||||
$stow->plan_unstow('pkg7b');
|
||||
stderr_like(
|
||||
sub { $stow->plan_unstow('pkg7b'); },
|
||||
$stow->{compat} ? qr/WARNING: skipping target which was current stow directory stow/ : qr//
|
||||
=> "warn when unstowing from ourself"
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'stow/pkg7b');
|
||||
is(
|
||||
readlink('stow/pkg7b'),
|
||||
|
|
@ -164,13 +249,16 @@ subtest("Don't unlink anything under the stow directory", sub {
|
|||
);
|
||||
});
|
||||
|
||||
subtest("Don't unlink any nodes under another stow directory", sub {
|
||||
subtests("Don't unlink any nodes under another stow directory",
|
||||
sub {
|
||||
make_path('stow');
|
||||
return { dir => 'stow' };
|
||||
},
|
||||
sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 5;
|
||||
my $stow = new_Stow(dir => 'stow');
|
||||
|
||||
make_path('stow2'); # make our alternate stow dir a subdir of target
|
||||
make_file('stow2/.stow');
|
||||
|
||||
init_stow2();
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_path('stow/pkg8a/stow2/pkg8b');
|
||||
make_file('stow/pkg8a/stow2/pkg8b/file8b');
|
||||
|
|
@ -179,10 +267,10 @@ subtest("Don't unlink any nodes under another stow directory", sub {
|
|||
stderr_like(
|
||||
sub { $stow->plan_unstow('pkg8a'); },
|
||||
qr/WARNING: skipping marked Stow directory stow2/
|
||||
=> "unstowing from ourself should skip stow"
|
||||
=> "warn when skipping unstowing"
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'stow2/pkg8b');
|
||||
is(
|
||||
readlink('stow2/pkg8b'),
|
||||
|
|
@ -191,11 +279,24 @@ subtest("Don't unlink any nodes under another stow directory", sub {
|
|||
);
|
||||
});
|
||||
|
||||
subtest("overriding already stowed documentation", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow(override => ['man9', 'info9']);
|
||||
make_file('stow/.stow');
|
||||
# This will be used by subsequent tests
|
||||
sub check_protected_dirs_skipped {
|
||||
my ($stderr) = @_;
|
||||
for my $dir (qw{stow stow2}) {
|
||||
like($stderr,
|
||||
qr/WARNING: skipping marked Stow directory $dir/
|
||||
=> "warn when skipping marked directory $dir");
|
||||
}
|
||||
}
|
||||
|
||||
subtests("overriding already stowed documentation",
|
||||
{override => ['man9', 'info9']},
|
||||
sub {
|
||||
my ($stow) = @_;
|
||||
plan_tests($stow, 2);
|
||||
|
||||
make_file('stow/.stow');
|
||||
init_stow2();
|
||||
make_path('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
make_path('man9/man1');
|
||||
|
|
@ -203,18 +304,22 @@ subtest("overriding already stowed documentation", sub {
|
|||
|
||||
make_path('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
$stow->plan_unstow('pkg9b');
|
||||
my $stderr = stderr_from { $stow->plan_unstow('pkg9b') };
|
||||
check_protected_dirs_skipped($stderr) if $stow->{compat};
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(!-l 'man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("deferring to already stowed documentation", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow(defer => ['man10', 'info10']);
|
||||
subtests("deferring to already stowed documentation",
|
||||
{defer => ['man10', 'info10']},
|
||||
sub {
|
||||
my ($stow) = @_;
|
||||
plan_tests($stow, 3);
|
||||
|
||||
init_stow2();
|
||||
make_path('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10a.1');
|
||||
make_path('man10/man1');
|
||||
|
|
@ -225,12 +330,12 @@ subtest("deferring to already stowed documentation", sub {
|
|||
make_file('../stow/pkg10b/man10/man1/file10b.1');
|
||||
make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
|
||||
|
||||
|
||||
make_path('../stow/pkg10c/man10/man1');
|
||||
make_file('../stow/pkg10c/man10/man1/file10a.1');
|
||||
$stow->plan_unstow('pkg10c');
|
||||
my $stderr = stderr_from { $stow->plan_unstow('pkg10c') };
|
||||
check_protected_dirs_skipped($stderr) if $stow->{compat};
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
|
||||
is($stow->get_conflict_count, 0);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
is(
|
||||
readlink('man10/man1/file10a.1'),
|
||||
'../../../stow/pkg10a/man10/man1/file10a.1'
|
||||
|
|
@ -238,10 +343,13 @@ subtest("deferring to already stowed documentation", sub {
|
|||
);
|
||||
});
|
||||
|
||||
subtest("Ignore temp files", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow(ignore => ['~', '\.#.*']);
|
||||
subtests("Ignore temp files",
|
||||
{ignore => ['~', '\.#.*']},
|
||||
sub {
|
||||
my ($stow) = @_;
|
||||
plan_tests($stow, 2);
|
||||
|
||||
init_stow2();
|
||||
make_path('../stow/pkg12/man12/man1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1~');
|
||||
|
|
@ -249,103 +357,123 @@ subtest("Ignore temp files", sub {
|
|||
make_path('man12/man1');
|
||||
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
|
||||
|
||||
$stow->plan_unstow('pkg12');
|
||||
my $stderr = stderr_from { $stow->plan_unstow('pkg12') };
|
||||
check_protected_dirs_skipped($stderr) if $stow->{compat};
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(!-e 'man12/man1/file12.1' => 'ignore temp files');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(! -e 'man12/man1/file12.1' => 'man12/man1/file12.1 was unstowed');
|
||||
});
|
||||
|
||||
subtest("Unstow an already unstowed package", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
subtests("Unstow an already unstowed package", sub {
|
||||
my ($stow) = @_;
|
||||
plan_tests($stow, 2);
|
||||
|
||||
my $stderr = stderr_from { $stow->plan_unstow('pkg12') };
|
||||
check_protected_dirs_skipped($stderr) if $stow->{compat};
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
|
||||
is(
|
||||
$stow->get_conflict_count, 0
|
||||
=> 'unstow already unstowed package pkg12'
|
||||
);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
});
|
||||
|
||||
subtest("Unstow a never stowed package", sub {
|
||||
subtests("Unstow a never stowed package", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 2;
|
||||
|
||||
eval { remove_dir("$TEST_DIR/target"); };
|
||||
mkdir("$TEST_DIR/target");
|
||||
eval { remove_dir($stow->{target}); };
|
||||
mkdir($stow->{target});
|
||||
|
||||
my $stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
|
||||
is(
|
||||
$stow->get_conflict_count,
|
||||
0
|
||||
=> 'unstow never stowed package pkg12'
|
||||
);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
});
|
||||
|
||||
subtest("Unstowing when target contains a real file shouldn't be an issue", sub {
|
||||
plan tests => 3;
|
||||
subtests("Unstowing when target contains real files shouldn't be an issue", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 4;
|
||||
|
||||
# Test both a file which do / don't overlap with the package
|
||||
make_path('man12/man1');
|
||||
make_file('man12/man1/alien');
|
||||
make_file('man12/man1/file12.1');
|
||||
|
||||
my $stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
|
||||
my %conflicts = $stow->get_conflicts;
|
||||
is($stow->get_conflict_count, 1);
|
||||
like(
|
||||
$conflicts{unstow}{pkg12}[0],
|
||||
qr!existing target is neither a link nor a directory: man12/man1/file12\.1!
|
||||
=> 'unstow pkg12 for third time'
|
||||
);
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f 'man12/man1/alien', 'alien untouched');
|
||||
ok(-f 'man12/man1/file12.1', 'file overlapping with pkg untouched');
|
||||
});
|
||||
|
||||
subtest("unstow a simple tree minimally when cwd isn't target", sub {
|
||||
subtests("unstow a simple tree minimally when cwd isn't target",
|
||||
sub {
|
||||
my $test_dir = shift;
|
||||
cd($repo);
|
||||
return {
|
||||
dir => "$test_dir/stow",
|
||||
target => "$test_dir/target"
|
||||
}
|
||||
},
|
||||
sub {
|
||||
my ($stow, $test_dir) = @_;
|
||||
plan tests => 3;
|
||||
cd('../..');
|
||||
my $stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg13/bin13");
|
||||
make_file("$TEST_DIR/stow/pkg13/bin13/file13");
|
||||
make_link("$TEST_DIR/target/bin13", '../stow/pkg13/bin13');
|
||||
make_path("$test_dir/stow/pkg13/bin13");
|
||||
make_file("$test_dir/stow/pkg13/bin13/file13");
|
||||
make_link("$test_dir/target/bin13", '../stow/pkg13/bin13');
|
||||
|
||||
$stow->plan_unstow('pkg13');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f "$TEST_DIR/stow/pkg13/bin13/file13");
|
||||
ok(! -e "$TEST_DIR/target/bin13" => 'unstow a simple tree');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f "$test_dir/stow/pkg13/bin13/file13", 'package file untouched');
|
||||
ok(! -e "$test_dir/target/bin13" => 'bin13/ unstowed');
|
||||
});
|
||||
|
||||
subtest("unstow a simple tree minimally with absolute stow dir when cwd isn't target", sub {
|
||||
subtests("unstow a simple tree minimally with absolute stow dir when cwd isn't target",
|
||||
sub {
|
||||
my $test_dir = shift;
|
||||
cd($repo);
|
||||
return {
|
||||
dir => canon_path("$test_dir/stow"),
|
||||
target => "$test_dir/target"
|
||||
};
|
||||
},
|
||||
sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => "$TEST_DIR/target");
|
||||
my ($stow, $test_dir) = @_;
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg14/bin14");
|
||||
make_file("$TEST_DIR/stow/pkg14/bin14/file14");
|
||||
make_link("$TEST_DIR/target/bin14", '../stow/pkg14/bin14');
|
||||
make_path("$test_dir/stow/pkg14/bin14");
|
||||
make_file("$test_dir/stow/pkg14/bin14/file14");
|
||||
make_link("$test_dir/target/bin14", '../stow/pkg14/bin14');
|
||||
|
||||
$stow->plan_unstow('pkg14');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f "$TEST_DIR/stow/pkg14/bin14/file14");
|
||||
ok(! -e "$TEST_DIR/target/bin14"
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f "$test_dir/stow/pkg14/bin14/file14");
|
||||
ok(! -e "$test_dir/target/bin14"
|
||||
=> 'unstow a simple tree with absolute stow dir'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("unstow a simple tree minimally with absolute stow AND target dirs when cwd isn't target", sub {
|
||||
subtests("unstow a simple tree minimally with absolute stow AND target dirs when cwd isn't target",
|
||||
sub {
|
||||
my $test_dir = shift;
|
||||
cd($repo);
|
||||
return {
|
||||
dir => canon_path("$test_dir/stow"),
|
||||
target => canon_path("$test_dir/target")
|
||||
};
|
||||
},
|
||||
sub {
|
||||
my ($stow, $test_dir) = @_;
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => canon_path("$TEST_DIR/target"));
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg15/bin15");
|
||||
make_file("$TEST_DIR/stow/pkg15/bin15/file15");
|
||||
make_link("$TEST_DIR/target/bin15", '../stow/pkg15/bin15');
|
||||
make_path("$test_dir/stow/pkg15/bin15");
|
||||
make_file("$test_dir/stow/pkg15/bin15/file15");
|
||||
make_link("$test_dir/target/bin15", '../stow/pkg15/bin15');
|
||||
|
||||
$stow->plan_unstow('pkg15');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f "$TEST_DIR/stow/pkg15/bin15/file15");
|
||||
ok(! -e "$TEST_DIR/target/bin15"
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f "$test_dir/stow/pkg15/bin15/file15");
|
||||
ok(! -e "$test_dir/target/bin15"
|
||||
=> 'unstow a simple tree with absolute stow and target dirs'
|
||||
);
|
||||
});
|
||||
|
|
@ -432,7 +560,6 @@ is_dir_not_symlink('no-folding-shared');
|
|||
is_dir_not_symlink('no-folding-shared2');
|
||||
is_dir_not_symlink('no-folding-shared2/subdir');
|
||||
|
||||
|
||||
# Todo
|
||||
#
|
||||
# Test cleaning up subdirs with --paranoid option
|
||||
# subtests("Test cleaning up subdirs with --paranoid option", sub {
|
||||
# TODO
|
||||
# });
|
||||
|
|
|
|||
393
t/unstow_orig.t
393
t/unstow_orig.t
|
|
@ -1,393 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# This file is part of GNU Stow.
|
||||
#
|
||||
# GNU Stow is free software: you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation, either version 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# GNU Stow is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
# General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program. If not, see https://www.gnu.org/licenses/.
|
||||
|
||||
#
|
||||
# Test unstowing packages in compat mode
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use File::Spec qw(make_path);
|
||||
use Test::More tests => 17;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use testutil;
|
||||
use Stow::Util qw(canon_path);
|
||||
|
||||
init_test_dirs();
|
||||
cd("$TEST_DIR/target");
|
||||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
my $stow;
|
||||
my %conflicts;
|
||||
|
||||
subtest("unstow a simple tree minimally", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_compat_Stow();
|
||||
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1', '../stow/pkg1/bin1');
|
||||
|
||||
$stow->plan_unstow('pkg1');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f '../stow/pkg1/bin1/file1');
|
||||
ok(! -e 'bin1' => 'unstow a simple tree');
|
||||
});
|
||||
|
||||
subtest("unstow a simple tree from an existing directory", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_compat_Stow();
|
||||
|
||||
make_path('lib2');
|
||||
make_path('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
|
||||
$stow->plan_unstow('pkg2');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f '../stow/pkg2/lib2/file2');
|
||||
ok(-d 'lib2'
|
||||
=> 'unstow simple tree from a pre-existing directory'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("fold tree after unstowing", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_compat_Stow();
|
||||
|
||||
make_path('bin3');
|
||||
|
||||
make_path('../stow/pkg3a/bin3');
|
||||
make_file('../stow/pkg3a/bin3/file3a');
|
||||
make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
|
||||
|
||||
make_path('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
|
||||
$stow->plan_unstow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-l 'bin3');
|
||||
is(readlink('bin3'), '../stow/pkg3a/bin3'
|
||||
=> 'fold tree after unstowing'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("existing link is owned by stow but is invalid so it gets removed anyway", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_compat_Stow();
|
||||
|
||||
make_path('bin4');
|
||||
make_path('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
|
||||
|
||||
$stow->plan_unstow('pkg4');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(! -e 'bin4/file4'
|
||||
=> q(remove invalid link owned by stow)
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Existing link is not owned by stow", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_compat_Stow();
|
||||
|
||||
make_path('../stow/pkg5/bin5');
|
||||
make_invalid_link('bin5', '../not-stow');
|
||||
|
||||
$stow->plan_unstow('pkg5');
|
||||
# Unlike the corresponding stow_contents.t test, this doesn't
|
||||
# cause any conflicts.
|
||||
#
|
||||
#like(
|
||||
# $Conflicts[-1], qr(can't unlink.*not owned by stow)
|
||||
# => q(existing link not owned by stow)
|
||||
#);
|
||||
ok(-l 'bin5');
|
||||
is(
|
||||
readlink('bin5'),
|
||||
'../not-stow'
|
||||
=> q(existing link not owned by stow)
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Target already exists, is owned by stow, but points to a different package", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_compat_Stow();
|
||||
|
||||
make_path('bin6');
|
||||
make_path('../stow/pkg6a/bin6');
|
||||
make_file('../stow/pkg6a/bin6/file6');
|
||||
make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
|
||||
|
||||
make_path('../stow/pkg6b/bin6');
|
||||
make_file('../stow/pkg6b/bin6/file6');
|
||||
|
||||
$stow->plan_unstow('pkg6b');
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-l 'bin6/file6');
|
||||
is(
|
||||
readlink('bin6/file6'),
|
||||
'../../stow/pkg6a/bin6/file6'
|
||||
=> q(ignore existing link that points to a different package)
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Don't unlink anything under the stow directory", sub {
|
||||
plan tests => 5;
|
||||
make_path('stow'); # make stow dir a subdir of target
|
||||
my $stow = new_compat_Stow(dir => 'stow');
|
||||
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_path('stow/pkg7a/stow/pkg7b');
|
||||
make_file('stow/pkg7a/stow/pkg7b/file7b');
|
||||
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
|
||||
|
||||
stderr_like(
|
||||
sub { $stow->plan_unstow('pkg7b'); },
|
||||
qr/WARNING: skipping target which was current stow directory stow/
|
||||
=> "warn when unstowing from ourself"
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-l 'stow/pkg7b');
|
||||
is(
|
||||
readlink('stow/pkg7b'),
|
||||
'../stow/pkg7a/stow/pkg7b'
|
||||
=> q(don't unlink any nodes under the stow directory)
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Don't unlink any nodes under another stow directory", sub {
|
||||
plan tests => 5;
|
||||
my $stow = new_compat_Stow(dir => 'stow');
|
||||
|
||||
make_path('stow2'); # make our alternate stow dir a subdir of target
|
||||
make_file('stow2/.stow');
|
||||
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_path('stow/pkg8a/stow2/pkg8b');
|
||||
make_file('stow/pkg8a/stow2/pkg8b/file8b');
|
||||
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
|
||||
|
||||
stderr_like(
|
||||
sub { $stow->plan_unstow('pkg8a'); },
|
||||
qr/WARNING: skipping target which was current stow directory stow/
|
||||
=> "warn when skipping unstowing"
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-l 'stow2/pkg8b');
|
||||
is(
|
||||
readlink('stow2/pkg8b'),
|
||||
'../stow/pkg8a/stow2/pkg8b'
|
||||
=> q(don't unlink any nodes under another stow directory)
|
||||
);
|
||||
});
|
||||
|
||||
# This will be used by subsequent tests
|
||||
sub check_protected_dirs_skipped {
|
||||
my $coderef = shift;
|
||||
my $stderr = stderr_from { $coderef->(); };
|
||||
for my $dir (qw{stow stow2}) {
|
||||
like($stderr,
|
||||
qr/WARNING: skipping marked Stow directory $dir/
|
||||
=> "warn when skipping marked directory $dir");
|
||||
}
|
||||
}
|
||||
|
||||
subtest("overriding already stowed documentation", sub {
|
||||
plan tests => 4;
|
||||
|
||||
my $stow = new_compat_Stow(override => ['man9', 'info9']);
|
||||
make_file('stow/.stow');
|
||||
|
||||
make_path('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
make_path('man9/man1');
|
||||
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
|
||||
|
||||
make_path('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
check_protected_dirs_skipped(
|
||||
sub { $stow->plan_unstow('pkg9b'); }
|
||||
);
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(!-l 'man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("deferring to already stowed documentation", sub {
|
||||
plan tests => 5;
|
||||
my $stow = new_compat_Stow(defer => ['man10', 'info10']);
|
||||
|
||||
make_path('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10a.1');
|
||||
make_path('man10/man1');
|
||||
make_link('man10/man1/file10a.1' => '../../../stow/pkg10a/man10/man1/file10a.1');
|
||||
|
||||
# need this to block folding
|
||||
make_path('../stow/pkg10b/man10/man1');
|
||||
make_file('../stow/pkg10b/man10/man1/file10b.1');
|
||||
make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
|
||||
|
||||
make_path('../stow/pkg10c/man10/man1');
|
||||
make_file('../stow/pkg10c/man10/man1/file10a.1');
|
||||
check_protected_dirs_skipped(
|
||||
sub { $stow->plan_unstow('pkg10c'); }
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
|
||||
is($stow->get_conflict_count, 0);
|
||||
is(
|
||||
readlink('man10/man1/file10a.1'),
|
||||
'../../../stow/pkg10a/man10/man1/file10a.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Ignore temp files", sub {
|
||||
plan tests => 4;
|
||||
my $stow = new_compat_Stow(ignore => ['~', '\.#.*']);
|
||||
|
||||
make_path('../stow/pkg12/man12/man1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1~');
|
||||
make_file('../stow/pkg12/man12/man1/.#file12.1');
|
||||
make_path('man12/man1');
|
||||
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
|
||||
|
||||
check_protected_dirs_skipped(
|
||||
sub { $stow->plan_unstow('pkg12'); }
|
||||
);
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(!-e 'man12/man1/file12.1' => 'ignore temp files');
|
||||
});
|
||||
|
||||
subtest("Unstow an already unstowed package", sub {
|
||||
plan tests => 4;
|
||||
my $stow = new_compat_Stow();
|
||||
check_protected_dirs_skipped(
|
||||
sub { $stow->plan_unstow('pkg12'); }
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
|
||||
is(
|
||||
$stow->get_conflict_count,
|
||||
0
|
||||
=> 'unstow already unstowed package pkg12'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Unstow a never stowed package", sub {
|
||||
plan tests => 4;
|
||||
|
||||
eval { remove_dir("$TEST_DIR/target"); };
|
||||
mkdir("$TEST_DIR/target");
|
||||
|
||||
my $stow = new_compat_Stow();
|
||||
check_protected_dirs_skipped(
|
||||
sub { $stow->plan_unstow('pkg12'); }
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
|
||||
is(
|
||||
$stow->get_conflict_count,
|
||||
0
|
||||
=> 'unstow never stowed package pkg12'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Unstowing when target contains a real file shouldn't be an issue", sub {
|
||||
plan tests => 5;
|
||||
make_file('man12/man1/file12.1');
|
||||
|
||||
my $stow = new_compat_Stow();
|
||||
check_protected_dirs_skipped(
|
||||
sub { $stow->plan_unstow('pkg12'); }
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
|
||||
%conflicts = $stow->get_conflicts;
|
||||
is($stow->get_conflict_count, 1);
|
||||
like(
|
||||
$conflicts{unstow}{pkg12}[0],
|
||||
qr!existing target is neither a link nor a directory: man12/man1/file12\.1!
|
||||
=> 'unstow pkg12 for third time'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("unstow a simple tree minimally when cwd isn't target", sub {
|
||||
plan tests => 3;
|
||||
cd('../..');
|
||||
my $stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg13/bin13");
|
||||
make_file("$TEST_DIR/stow/pkg13/bin13/file13");
|
||||
make_link("$TEST_DIR/target/bin13", '../stow/pkg13/bin13');
|
||||
|
||||
$stow->plan_unstow('pkg13');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f "$TEST_DIR/stow/pkg13/bin13/file13");
|
||||
ok(! -e "$TEST_DIR/target/bin13" => 'unstow a simple tree');
|
||||
});
|
||||
|
||||
subtest("unstow a simple tree minimally with absolute stow dir when cwd isn't target", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => "$TEST_DIR/target");
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg14/bin14");
|
||||
make_file("$TEST_DIR/stow/pkg14/bin14/file14");
|
||||
make_link("$TEST_DIR/target/bin14", '../stow/pkg14/bin14');
|
||||
|
||||
$stow->plan_unstow('pkg14');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f "$TEST_DIR/stow/pkg14/bin14/file14");
|
||||
ok(! -e "$TEST_DIR/target/bin14"
|
||||
=> 'unstow a simple tree with absolute stow dir'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("unstow a simple tree minimally with absolute stow AND target dirs when cwd isn't target", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => canon_path("$TEST_DIR/target"));
|
||||
make_path("$TEST_DIR/stow/pkg15/bin15");
|
||||
make_file("$TEST_DIR/stow/pkg15/bin15/file15");
|
||||
make_link("$TEST_DIR/target/bin15", '../stow/pkg15/bin15');
|
||||
|
||||
$stow->plan_unstow('pkg15');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f "$TEST_DIR/stow/pkg15/bin15/file15");
|
||||
ok(! -e "$TEST_DIR/target/bin15"
|
||||
=> 'unstow a simple tree with absolute stow and target dirs'
|
||||
);
|
||||
});
|
||||
|
||||
# subtest("Test cleaning up subdirs with --paranoid option", sub {
|
||||
# TODO
|
||||
# });
|
||||
Loading…
Reference in a new issue