t/ignore.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 ignore lists.
  20 #
  21
  22 use strict;
  23 use warnings;
  24
  25 use File::Temp qw(tempdir);
  26 use Test::More tests => 287;
  27
  28 use testutil;
  29 use Stow::Util qw(join_paths);
  30
  31 init_test_dirs();
  32 cd("$TEST_DIR/target");
  33
  34 my $stow = new_Stow();
  35
  36 sub test_ignores {
  37     my ($stow_path, $package, $context, @tests) = @_;
  38     $context ||= '';
  39     while (@tests) {
  40         my $path          = shift @tests;
  41         my $should_ignore = shift @tests;
  42         my $not = $should_ignore ? '' : ' not';
  43         my $was_ignored = $stow->ignore($stow_path, $package, $path);
  44         is(
  45             $was_ignored, $should_ignore,
  46             "Should$not ignore $path $context"
  47         );
  48     }
  49 }
  50
  51 sub test_local_ignore_list_always_ignored_at_top_level {
  52     my ($stow_path, $package, $context) = @_;
  53     test_ignores(
  54         $stow_path, $package, $context,
  55         $Stow::LOCAL_IGNORE_FILE             => 1,
  56         "subdir/" . $Stow::LOCAL_IGNORE_FILE => 0,
  57     );
  58 }
  59
  60 sub test_built_in_list {
  61     my ($stow_path, $package, $context, $expect_ignores) = @_;
  62
  63     for my $ignored ('CVS', '.cvsignore', '#autosave#') {
  64         for my $path ($ignored, "foo/bar/$ignored") {
  65             my $suffix = "$path.suffix";
  66             (my $prefix = $path) =~ s!([^/]+)$!prefix.$1!;
  67
  68             test_ignores(
  69                 $stow_path, $package, $context,
  70                 $path   => $expect_ignores,
  71                 $prefix => 0,
  72                 $suffix => 0,
  73             );
  74         }
  75     }
  76
  77     # The pattern catching lock files allows suffixes but not prefixes
  78     for my $ignored ('.#lock-file') {
  79         for my $path ($ignored, "foo/bar/$ignored") {
  80             my $suffix = "$path.suffix";
  81             (my $prefix = $path) =~ s!([^/]+)$!prefix.$1!;
  82
  83             test_ignores(
  84                 $stow_path, $package, $context,
  85                 $path   => $expect_ignores,
  86                 $prefix => 0,
  87                 $suffix => $expect_ignores,
  88             );
  89         }
  90     }
  91 }
  92
  93 sub test_user_global_list {
  94     my ($stow_path, $package, $context, $expect_ignores) = @_;
  95
  96     for my $path ('', 'foo/bar/') {
  97         test_ignores(
  98             $stow_path, $package, $context,
  99             $path . 'exact'       => $expect_ignores,
 100             $path . '0exact'      => 0,
 101             $path . 'exact1'      => 0,
 102             $path . '0exact1'     => 0,
 103
 104             $path . 'substring'   => 0,
 105             $path . '0substring'  => 0,
 106             $path . 'substring1'  => 0,
 107             $path . '0substring1' => $expect_ignores,
 108         );
 109     }
 110 }
 111
 112 sub setup_user_global_list {
 113     # Now test with global ignore list in home directory
 114     $ENV{HOME} = tempdir();
 115     make_file(join_paths($ENV{HOME}, $Stow::GLOBAL_IGNORE_FILE), <<EOF);
 116 exact
 117 .+substring.+ # here's a comment
 118 .+\.extension
 119 myprefix.+       #hi mum
 120 EOF
 121 }
 122
 123 sub setup_package_local_list {
 124     my ($stow_path, $package, $list) = @_;
 125     my $package_path = join_paths($stow_path, $package);
 126     make_path($package_path);
 127     my $local_ignore = join_paths($package_path, $Stow::LOCAL_IGNORE_FILE);
 128     make_file($local_ignore, $list);
 129     $stow->invalidate_memoized_regexp($local_ignore);
 130     return $local_ignore;
 131 }
 132
 133 sub main {
 134     my $stow_path = '../stow';
 135     my $package;
 136     my $context;
 137
 138     # Test built-in list first.  init_test_dirs() already set
 139     # $ENV{HOME} to ensure that we're not using the user's global
 140     # ignore list.
 141     $package = 'non-existent-package';
 142     $context = "when using built-in list";
 143     test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
 144     test_built_in_list($stow_path, $package, $context, 1);
 145
 146     # Test ~/.stow-global-ignore
 147     setup_user_global_list();
 148     $context = "when using ~/$Stow::GLOBAL_IGNORE_FILE";
 149     test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
 150     test_built_in_list($stow_path, $package, $context, 0);
 151     test_user_global_list($stow_path, $package, $context, 1);
 152
 153     # Test empty package-local .stow-local-ignore
 154     $package = 'ignorepkg';
 155     my $local_ignore = setup_package_local_list($stow_path, $package, "");
 156     $context = "when using empty $local_ignore";
 157     test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
 158     test_built_in_list($stow_path, $package, $context, 0);
 159     test_user_global_list($stow_path, $package, $context, 0);
 160     test_ignores(
 161         $stow_path, $package, $context,
 162         'random'          => 0,
 163         'foo2/bar'        => 0,
 164         'foo2/bars'       => 0,
 165         'foo2/bar/random' => 0,
 166         'foo2/bazqux'     => 0,
 167         'xfoo2/bazqux'    => 0,
 168     );
 169
 170     # Test package-local .stow-local-ignore with only path segment regexps
 171     $local_ignore = setup_package_local_list($stow_path, $package, <<EOF);
 172 random
 173 EOF
 174     $context = "when using $local_ignore with only path segment regexps";
 175     test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
 176     test_built_in_list($stow_path, $package, $context, 0);
 177     test_user_global_list($stow_path, $package, $context, 0);
 178     test_ignores(
 179         $stow_path, $package, $context,
 180         'random'          => 1,
 181         'foo2/bar'        => 0,
 182         'foo2/bars'       => 0,
 183         'foo2/bar/random' => 1,
 184         'foo2/bazqux'     => 0,
 185         'xfoo2/bazqux'    => 0,
 186     );
 187
 188     # Test package-local .stow-local-ignore with only full path regexps
 189     $local_ignore = setup_package_local_list($stow_path, $package, <<EOF);
 190 foo2/bar
 191 EOF
 192     $context = "when using $local_ignore with only full path regexps";
 193     test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
 194     test_built_in_list($stow_path, $package, $context, 0);
 195     test_user_global_list($stow_path, $package, $context, 0);
 196     test_ignores(
 197         $stow_path, $package, $context,
 198         'random'          => 0,
 199         'foo2/bar'        => 1,
 200         'foo2/bars'       => 0,
 201         'foo2/bar/random' => 1,
 202         'foo2/bazqux'     => 0,
 203         'xfoo2/bazqux'    => 0,
 204     );
 205
 206     # Test package-local .stow-local-ignore with a mixture of regexps
 207     $local_ignore = setup_package_local_list($stow_path, $package, <<EOF);
 208 foo2/bar
 209 random
 210 foo2/baz.+
 211 EOF
 212     $context = "when using $local_ignore with mixture of regexps";
 213     test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
 214     test_built_in_list($stow_path, $package, $context, 0);
 215     test_user_global_list($stow_path, $package, $context, 0);
 216     test_ignores(
 217         $stow_path, $package, $context,
 218         'random'          => 1,
 219         'foo2/bar'        => 1,
 220         'foo2/bars'       => 0,
 221         'foo2/bar/random' => 1,
 222         'foo2/bazqux'     => 1,
 223         'xfoo2/bazqux'    => 0,
 224     );
 225
 226     test_examples_in_manual($stow_path);
 227     test_invalid_regexp($stow_path, "Invalid segment regexp in list", <<EOF);
 228 this one's ok
 229 this one isn't|*!
 230 but this one is
 231 EOF
 232     test_invalid_regexp($stow_path, "Invalid full path regexp in list", <<EOF);
 233 this one's ok
 234 this/one isn't|*!
 235 but this one is
 236 EOF
 237     test_ignore_via_stow($stow_path);
 238 }
 239
 240 sub test_examples_in_manual {
 241     my ($stow_path) = @_;
 242     my $package = 'ignorepkg';
 243     my $context = "(example from manual)";
 244
 245     for my $re ('bazqux', 'baz.*', '.*qux', 'bar/.*x', '^/foo/.*qux') {
 246         my $local_ignore = setup_package_local_list($stow_path, $package, "$re\n");
 247         test_ignores(
 248             $stow_path, $package, $context,
 249             "foo/bar/bazqux" => 1,
 250         );
 251     }
 252
 253     for my $re ('bar', 'baz', 'qux', 'o/bar/b') {
 254         my $local_ignore = setup_package_local_list($stow_path, $package, "$re\n");
 255         test_ignores(
 256             $stow_path, $package, $context,
 257             "foo/bar/bazqux" => 0,
 258         );
 259     }
 260 }
 261
 262 sub test_invalid_regexp {
 263     my ($stow_path, $context, $list) = @_;
 264     my $package = 'ignorepkg';
 265
 266     my $local_ignore = setup_package_local_list($stow_path, $package, $list);
 267     eval {
 268         test_ignores(
 269             $stow_path, $package, $context,
 270             "foo/bar/bazqux" => 1,
 271         );
 272     };
 273     like($@, qr/^Failed to compile regexp: Quantifier follows nothing in regex;/,
 274          $context);
 275 }
 276
 277 sub test_ignore_via_stow {
 278     my ($stow_path) = @_;
 279
 280     my $package = 'pkg1';
 281     make_path("$stow_path/$package/foo/bar");
 282     make_file("$stow_path/$package/foo/bar/baz");
 283
 284     setup_package_local_list($stow_path, $package, 'foo');
 285     $stow->plan_stow($package);
 286     is($stow->get_tasks(),     0, 'top dir ignored');
 287     is($stow->get_conflicts(), 0, 'top dir ignored, no conflicts');
 288
 289     make_path("foo");
 290     for my $ignore ('bar', 'foo/bar', '/foo/bar', '^/foo/bar', '^/fo.+ar') {
 291         setup_package_local_list($stow_path, $package, $ignore);
 292         $stow->plan_stow($package);
 293         is($stow->get_tasks(), 0, "bar ignored via $ignore");
 294         is($stow->get_conflicts(), 0, 'bar ignored, no conflicts');
 295     }
 296
 297     make_file("$stow_path/$package/foo/qux");
 298     $stow->plan_stow($package);
 299     $stow->process_tasks();
 300     is($stow->get_conflicts(), 0, 'no conflicts stowing qux');
 301     ok(! -e "foo/bar", "bar ignore prevented stow");
 302     ok(-l "foo/qux",   "qux not ignored and stowed");
 303     is(readlink("foo/qux"), "../$stow_path/$package/foo/qux", "qux stowed correctly");
 304 }
 305
 306 main();