t/cleanup_invalid_links.t

   1 #!/usr/bin/perl
   2 #
   3 # This file is part of GNU Stow.
   4 #
   5 # GNU Stow is free software: you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation, either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # GNU Stow is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program. If not, see https://www.gnu.org/licenses/.
  17
  18 #
  19 # Testing cleanup_invalid_links()
  20 #
  21
  22 use strict;
  23 use warnings;
  24
  25 use Test::More tests => 4;
  26 use English qw(-no_match_vars);
  27
  28 use testutil;
  29 use Stow::Util;
  30
  31 init_test_dirs();
  32 cd("$TEST_DIR/target");
  33
  34 my $stow;
  35
  36 # Note that each of the following tests use a distinct set of files
  37
  38 subtest('nothing to clean in a simple tree' => sub {
  39     plan tests => 1;
  40
  41     make_path('../stow/pkg1/bin1');
  42     make_file('../stow/pkg1/bin1/file1');
  43     make_link('bin1', '../stow/pkg1/bin1');
  44
  45     $stow = new_Stow();
  46     $stow->cleanup_invalid_links('./');
  47     is(
  48         scalar($stow->get_tasks), 0
  49         => 'nothing to clean'
  50     );
  51 });
  52
  53 subtest('cleanup an orphaned owned link in a simple tree' => sub {
  54     plan tests => 3;
  55
  56     make_path('bin2');
  57     make_path('../stow/pkg2/bin2');
  58     make_file('../stow/pkg2/bin2/file2a');
  59     make_link('bin2/file2a', '../../stow/pkg2/bin2/file2a');
  60     make_invalid_link('bin2/file2b', '../../stow/pkg2/bin2/file2b');
  61
  62     $stow = new_Stow();
  63     $stow->cleanup_invalid_links('bin2');
  64     is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link');
  65     is(scalar($stow->get_tasks), 1, 'one task cleaning up bad link');
  66     is($stow->link_task_action('bin2/file2b'), 'remove', 'removal task for bad link');
  67 });
  68
  69 subtest("don't cleanup a bad link not owned by stow" => sub {
  70     plan tests => 2;
  71
  72     make_path('bin3');
  73     make_path('../stow/pkg3/bin3');
  74     make_file('../stow/pkg3/bin3/file3a');
  75     make_link('bin3/file3a', '../../stow/pkg3/bin3/file3a');
  76     make_invalid_link('bin3/file3b', '../../empty');
  77
  78     $stow = new_Stow();
  79     $stow->cleanup_invalid_links('bin3');
  80     is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link not owned by stow');
  81     is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
  82 });
  83
  84 subtest("don't cleanup a valid link in the target not owned by stow" => sub {
  85     plan tests => 2;
  86
  87     make_path('bin4');
  88     make_path('../stow/pkg4/bin4');
  89     make_file('../stow/pkg4/bin4/file3a');
  90     make_link('bin4/file3a', '../../stow/pkg4/bin4/file3a');
  91     make_file("unowned");
  92     make_link('bin4/file3b', '../unowned');
  93
  94     $stow = new_Stow();
  95     $stow->cleanup_invalid_links('bin4');
  96     is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link not owned by stow');
  97     is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
  98 });