From 06fdfc185f1e4c27c01347021fd258dd6466a03c Mon Sep 17 00:00:00 2001 From: Adam Spiers Date: Tue, 2 Apr 2024 00:36:51 +0100 Subject: [PATCH] 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. --- .gitignore | 2 +- MANIFEST | 1 - MANIFEST.SKIP | 2 +- Makefile.am | 2 +- lib/Stow.pm.in | 83 ++-------- t/dotfiles.t | 2 +- t/testutil.pm | 16 +- t/unstow.t | 357 +++++++++++++++++++++++++++++-------------- t/unstow_orig.t | 393 ------------------------------------------------ 9 files changed, 269 insertions(+), 589 deletions(-) delete mode 100755 t/unstow_orig.t diff --git a/.gitignore b/.gitignore index 81f5836..caf4ba3 100644 --- a/.gitignore +++ b/.gitignore @@ -10,7 +10,7 @@ /doc/stow.info /doc/version.texi /playground/ -tmp-testing-trees/ +tmp-testing-trees*/ _build/ autom4te.cache/ blib/ diff --git a/MANIFEST b/MANIFEST index 8f7a812..09cb2bf 100644 --- a/MANIFEST +++ b/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 diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 033f12a..522b3fd 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -83,7 +83,7 @@ ^doc/HOWTO-RELEASE$ # Avoid test files -tmp-testing-trees +tmp-testing-trees* ^.coveralls.yml ^.github/workflows/ ^.travis.yml diff --git a/Makefile.am b/Makefile.am index 7bd43bd..56abbef 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 diff --git a/lib/Stow.pm.in b/lib/Stow.pm.in index e844253..40351bb 100755 --- a/lib/Stow.pm.in +++ b/lib/Stow.pm.in @@ -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 diff --git a/t/dotfiles.t b/t/dotfiles.t index 83874ca..5719eaa 100755 --- a/t/dotfiles.t +++ b/t/dotfiles.t @@ -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'); }); diff --git a/t/testutil.pm b/t/testutil.pm index b7c1549..2b4e097 100755 --- a/t/testutil.pm +++ b/t/testutil.pm @@ -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 { diff --git a/t/unstow.t b/t/unstow.t index 15288c9..9fd7852 100755 --- a/t/unstow.t +++ b/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 +# }); diff --git a/t/unstow_orig.t b/t/unstow_orig.t deleted file mode 100755 index 9d62bd9..0000000 --- a/t/unstow_orig.t +++ /dev/null @@ -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 -# });