00dani/stow
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Add support for ignore lists.

Browse source
This commit is contained in:
Adam Spiers 2011-11-23 23:45:48 +00:00
parent 7777e181a8
commit ea82ef5b8b
18 changed files with 881 additions and 167 deletions
Download patch file Download diff file Expand all files Collapse all files

2
t/chkstow.t
View file

@ -14,7 +14,7 @@ use Test::More tests => 7;
use Test::Output;
use English qw(-no_match_vars);
make_fresh_stow_and_target_dirs();
init_test_dirs();
cd('t/target');
# setup stow directory

2
t/cleanup_invalid_links.t
View file

@ -12,7 +12,7 @@ use English qw(-no_match_vars);
use testutil;
make_fresh_stow_and_target_dirs();
init_test_dirs();
cd('t/target');
my $stow;

2
t/examples.t
View file

@ -12,7 +12,7 @@ use testutil;
use Test::More tests => 10;
use English qw(-no_match_vars);
make_fresh_stow_and_target_dirs();
init_test_dirs();
cd('t/target');
my $stow;

38
t/find_stowed_path.t
View file

@ -11,21 +11,21 @@ use testutil;
use Test::More tests => 6;
make_fresh_stow_and_target_dirs();
init_test_dirs();
my $stow = new_Stow(dir => 't/stow');
is(
$stow->find_stowed_path('t/target/a/b/c', '../../../stow/a/b/c'),
't/stow/a/b/c'
is_deeply(
[ $stow->find_stowed_path('t/target/a/b/c', '../../../stow/a/b/c') ],
[ 't/stow/a/b/c', 't/stow', 'a' ]
=> 'from root'
);
cd('t/target');
$stow->set_stow_dir('../stow');
is(
$stow->find_stowed_path('a/b/c','../../../stow/a/b/c'),
'../stow/a/b/c'
is_deeply(
[ $stow->find_stowed_path('a/b/c','../../../stow/a/b/c') ],
[ '../stow/a/b/c', '../stow', 'a' ]
=> 'from target directory'
);
@ -33,31 +33,31 @@ make_dir('stow');
cd('../..');
$stow->set_stow_dir('t/target/stow');
is(
$stow->find_stowed_path('t/target/a/b/c', '../../stow/a/b/c'),
't/target/stow/a/b/c'
is_deeply(
[ $stow->find_stowed_path('t/target/a/b/c', '../../stow/a/b/c') ],
[ 't/target/stow/a/b/c', 't/target/stow', 'a' ]
=> 'stow is subdir of target directory'
);
is(
$stow->find_stowed_path('t/target/a/b/c','../../empty'),
''
is_deeply(
[ $stow->find_stowed_path('t/target/a/b/c','../../empty') ],
[ '', '', '' ]
=> 'target is not stowed'
);
make_dir('t/target/stow2');
make_file('t/target/stow2/.stow');
is(
$stow->find_stowed_path('t/target/a/b/c','../../stow2/a/b/c'),
't/target/stow2/a/b/c'
is_deeply(
[ $stow->find_stowed_path('t/target/a/b/c','../../stow2/a/b/c') ],
[ 't/target/stow2/a/b/c', 't/target/stow2', 'a' ]
=> q(detect alternate stow directory)
);
# Possible corner case with rogue symlink pointing to ancestor of
# stow dir.
is(
$stow->find_stowed_path('t/target/a/b/c','../../..'),
''
is_deeply(
[ $stow->find_stowed_path('t/target/a/b/c','../../..') ],
[ '', '', '' ]
=> q(corner case - link points to ancestor of stow dir)
);

2
t/foldable.t
View file

@ -12,7 +12,7 @@ use testutil;
use Test::More tests => 4;
use English qw(-no_match_vars);
make_fresh_stow_and_target_dirs();
init_test_dirs();
cd('t/target');
my $stow = new_Stow(dir => '../stow');

291
t/ignore.t Executable file
View file

@ -0,0 +1,291 @@
#!/usr/local/bin/perl
#
# Testing ignore lists.
#
use strict;
use warnings;
use File::Temp qw(tempdir);
use Test::More tests => 286;
use testutil;
use Stow::Util qw(join_paths);
init_test_dirs();
cd('t/target');
my $stow = new_Stow();
sub test_ignores {
my ($stow_path, $package, $context, @tests) = @_;
$context ||= '';
while (@tests) {
my $path = shift @tests;
my $should_ignore = shift @tests;
my $not = $should_ignore ? '' : ' not';
my $was_ignored = $stow->ignore($stow_path, $package, $path);
is(
$was_ignored, $should_ignore,
"Should$not ignore $path $context"
);
}
}
sub test_local_ignore_list_always_ignored_at_top_level {
my ($stow_path, $package, $context) = @_;
test_ignores(
$stow_path, $package, $context,
$Stow::LOCAL_IGNORE_FILE => 1,
"subdir/" . $Stow::LOCAL_IGNORE_FILE => 0,
);
}
sub test_built_in_list {
my ($stow_path, $package, $context, $expect_ignores) = @_;
for my $ignored ('CVS', '.cvsignore', '#autosave#') {
for my $path ($ignored, "foo/bar/$ignored") {
my $suffix = "$path.suffix";
(my $prefix = $path) =~ s!([^/]+)$!prefix.$1!;
test_ignores(
$stow_path, $package, $context,
$path => $expect_ignores,
$prefix => 0,
$suffix => 0,
);
}
}
# The pattern catching lock files allows suffixes but not prefixes
for my $ignored ('.#lock-file') {
for my $path ($ignored, "foo/bar/$ignored") {
my $suffix = "$path.suffix";
(my $prefix = $path) =~ s!([^/]+)$!prefix.$1!;
test_ignores(
$stow_path, $package, $context,
$path => $expect_ignores,
$prefix => 0,
$suffix => $expect_ignores,
);
}
}
}
sub test_user_global_list {
my ($stow_path, $package, $context, $expect_ignores) = @_;
for my $path ('', 'foo/bar/') {
test_ignores(
$stow_path, $package, $context,
$path . 'exact' => $expect_ignores,
$path . '0exact' => 0,
$path . 'exact1' => 0,
$path . '0exact1' => 0,
$path . 'substring' => 0,
$path . '0substring' => 0,
$path . 'substring1' => 0,
$path . '0substring1' => $expect_ignores,
);
}
}
sub setup_user_global_list {
# Now test with global ignore list in home directory
$ENV{HOME} = tempdir();
make_file(join_paths($ENV{HOME}, $Stow::GLOBAL_IGNORE_FILE), <<EOF);
exact
.+substring.+ # here's a comment
.+\.extension
myprefix.+ #hi mum
EOF
}
sub setup_package_local_list {
my ($stow_path, $package, $list) = @_;
my $package_path = join_paths($stow_path, $package);
make_dir($package_path);
my $local_ignore = join_paths($package_path, $Stow::LOCAL_IGNORE_FILE);
make_file($local_ignore, $list);
$stow->invalidate_memoized_regexp($local_ignore);
return $local_ignore;
}
sub main {
my $stow_path = '../stow';
my $package;
my $context;
# Test built-in list first. init_test_dirs() already set
# $ENV{HOME} to ensure that we're not using the user's global
# ignore list.
$package = 'non-existent-package';
$context = "when using built-in list";
test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
test_built_in_list($stow_path, $package, $context, 1);
# Test ~/.stow-global-ignore
setup_user_global_list();
$context = "when using ~/$Stow::GLOBAL_IGNORE_FILE";
test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
test_built_in_list($stow_path, $package, $context, 0);
test_user_global_list($stow_path, $package, $context, 1);
# Test empty package-local .stow-local-ignore
$package = 'ignorepkg';
my $local_ignore = setup_package_local_list($stow_path, $package, "");
$context = "when using empty $local_ignore";
test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
test_built_in_list($stow_path, $package, $context, 0);
test_user_global_list($stow_path, $package, $context, 0);
test_ignores(
$stow_path, $package, $context,
'random' => 0,
'foo2/bar' => 0,
'foo2/bars' => 0,
'foo2/bar/random' => 0,
'foo2/bazqux' => 0,
'xfoo2/bazqux' => 0,
);
# Test package-local .stow-local-ignore with only path segment regexps
$local_ignore = setup_package_local_list($stow_path, $package, <<EOF);
random
EOF
$context = "when using $local_ignore with only path segment regexps";
test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
test_built_in_list($stow_path, $package, $context, 0);
test_user_global_list($stow_path, $package, $context, 0);
test_ignores(
$stow_path, $package, $context,
'random' => 1,
'foo2/bar' => 0,
'foo2/bars' => 0,
'foo2/bar/random' => 1,
'foo2/bazqux' => 0,
'xfoo2/bazqux' => 0,
);
# Test package-local .stow-local-ignore with only full path regexps
$local_ignore = setup_package_local_list($stow_path, $package, <<EOF);
foo2/bar
EOF
$context = "when using $local_ignore with only full path regexps";
test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
test_built_in_list($stow_path, $package, $context, 0);
test_user_global_list($stow_path, $package, $context, 0);
test_ignores(
$stow_path, $package, $context,
'random' => 0,
'foo2/bar' => 1,
'foo2/bars' => 0,
'foo2/bar/random' => 1,
'foo2/bazqux' => 0,
'xfoo2/bazqux' => 0,
);
# Test package-local .stow-local-ignore with a mixture of regexps
$local_ignore = setup_package_local_list($stow_path, $package, <<EOF);
foo2/bar
random
foo2/baz.+
EOF
$context = "when using $local_ignore with mixture of regexps";
test_local_ignore_list_always_ignored_at_top_level($stow_path, $package, $context);
test_built_in_list($stow_path, $package, $context, 0);
test_user_global_list($stow_path, $package, $context, 0);
test_ignores(
$stow_path, $package, $context,
'random' => 1,
'foo2/bar' => 1,
'foo2/bars' => 0,
'foo2/bar/random' => 1,
'foo2/bazqux' => 1,
'xfoo2/bazqux' => 0,
);
test_examples_in_manual($stow_path);
test_invalid_regexp($stow_path, "Invalid segment regexp in list", <<EOF);
this one's ok
this one isn't|*!
but this one is
EOF
test_invalid_regexp($stow_path, "Invalid full path regexp in list", <<EOF);
this one's ok
this/one isn't|*!
but this one is
EOF
test_ignore_via_stow($stow_path);
}
sub test_examples_in_manual {
my ($stow_path) = @_;
my $package = 'ignorepkg';
my $context = "(example from manual)";
for my $re ('bazqux', 'baz.*', '.*qux', 'bar/.*x', '^/foo/.*qux') {
my $local_ignore = setup_package_local_list($stow_path, $package, "$re\n");
test_ignores(
$stow_path, $package, $context,
"foo/bar/bazqux" => 1,
);
}
for my $re ('bar', 'baz', 'qux') {
my $local_ignore = setup_package_local_list($stow_path, $package, "$re\n");
test_ignores(
$stow_path, $package, $context,
"foo/bar/bazqux" => 0,
);
}
}
sub test_invalid_regexp {
my ($stow_path, $context, $list) = @_;
my $package = 'ignorepkg';
my $local_ignore = setup_package_local_list($stow_path, $package, $list);
eval {
test_ignores(
$stow_path, $package, $context,
"foo/bar/bazqux" => 1,
);
};
like($@, qr/^Failed to compile regexp: Quantifier follows nothing in regex;/,
$context);
}
sub test_ignore_via_stow {
my ($stow_path) = @_;
my $package = 'pkg1';
make_dir("$stow_path/$package/foo/bar");
make_file("$stow_path/$package/foo/bar/baz");
setup_package_local_list($stow_path, $package, 'foo');
$stow->plan_stow($package);
is($stow->get_tasks(), 0, 'top dir ignored');
is($stow->get_conflicts(), 0, 'top dir ignored, no conflicts');
make_dir("foo");
for my $ignore ('bar', 'foo/bar', '/foo/bar', '^/foo/bar', '^/fo.+ar') {
setup_package_local_list($stow_path, $package, $ignore);
$stow->plan_stow($package);
is($stow->get_tasks(), 0, "bar ignored via $ignore");
is($stow->get_conflicts(), 0, 'bar ignored, no conflicts');
}
make_file("$stow_path/$package/foo/qux");
$stow->plan_stow($package);
$stow->process_tasks();
is($stow->get_conflicts(), 0, 'no conflicts stowing qux');
ok(! -e "foo/bar", "bar ignore prevented stow");
ok(-l "foo/qux", "qux not ignored and stowed");
is(readlink("foo/qux"), "../$stow_path/$package/foo/qux", "qux stowed correctly");
}
main();

2
t/stow.t
View file

@ -13,7 +13,7 @@ use testutil;
require 'stow';
make_fresh_stow_and_target_dirs();
init_test_dirs();
local @ARGV = (
'-v',

2
t/stow_contents.t
View file

@ -14,7 +14,7 @@ use English qw(-no_match_vars);
use Stow::Util qw(canon_path);
use testutil;
make_fresh_stow_and_target_dirs();
init_test_dirs();
cd('t/target');
my $stow;

25
t/testutil.pm
View file

@ -10,14 +10,17 @@ use warnings;
use Stow;
use Stow::Util qw(parent);
sub make_fresh_stow_and_target_dirs {
sub init_test_dirs {
die "t/ didn't exist; are you running the tests from the root of the tree?\n"
unless -d 't';
for my $dir ('t/target', 't/stow') {
eval { remove_dir($dir); };
-d $dir and remove_dir($dir);
make_dir($dir);
}
# Don't let user's ~/.stow-global-ignore affect test results
$ENV{HOME} = '/tmp/fake/home';
}
sub new_Stow {
@ -90,22 +93,22 @@ sub make_dir {
# Name : create_file()
# Purpose : create an empty file
# Parameters: $path => proposed path to the file
# : $contents => (optional) contents to write to file
# Returns : n/a
# Throws : fatal error if the file could not be created
# Comments : detects clash with an existing non-file
#============================================================================
sub make_file {
my ($path) =@_;
my ($path, $contents) =@_;
if (not -e $path) {
open my $FILE ,'>', $path
or die "could not create file: $path ($!)\n";
close $FILE;
}
elsif (not -f $path) {
if (-e $path and ! -f $path) {
die "a non-file already exists at $path\n";
}
return;
open my $FILE ,'>', $path
or die "could not create file: $path ($!)\n";
print $FILE $contents if defined $contents;
close $FILE;
}
#===== SUBROUTINE ===========================================================
@ -168,7 +171,7 @@ sub remove_dir {
next NODE if $node eq '..';
my $path = "$dir/$node";
if (-l $path or -z $path) {
if (-l $path or -z $path or $node eq $Stow::LOCAL_IGNORE_FILE) {
unlink $path or die "cannot unlink $path ($!)\n";
}
elsif (-d "$path") {

2
t/unstow_contents.t
View file

@ -14,7 +14,7 @@ use English qw(-no_match_vars);
use testutil;
use Stow::Util qw(canon_path);
make_fresh_stow_and_target_dirs();
init_test_dirs();
cd('t/target');
# Note that each of the following tests use a distinct set of files

2
t/unstow_contents_orig.t
View file

@ -14,7 +14,7 @@ use English qw(-no_match_vars);
use testutil;
use Stow::Util qw(canon_path);
make_fresh_stow_and_target_dirs();
init_test_dirs();
cd('t/target');
# Note that each of the following tests use a distinct set of files