Major refactoring of code into separate Stow and Stow::Util Perl modules
This commit is contained in:
Adam Spiers
parent
1365c4c4f1
commit
dc61da22d4
20 changed files with 2439 additions and 1980 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -9,3 +9,4 @@ stamp-vti
|
|||
stow.info
|
||||
t/target/
|
||||
version.texi
|
||||
lib/Stow.pm
|
||||
|
|
|
|||
14
Makefile.am
14
Makefile.am
|
|
@ -4,6 +4,8 @@ bin_SCRIPTS = stow chkstow
|
|||
info_TEXINFOS = stow.texi
|
||||
dist_man_MANS = stow.8
|
||||
dist_doc_DATA = README
|
||||
pmdir = $(libdir)/perl5
|
||||
pm_DATA = lib/Stow.pm lib/Stow/Util.pm
|
||||
|
||||
TESTS_ENVIRONMENT=$(PERL) -I $(top_srcdir)
|
||||
TESTS = \
|
||||
|
|
@ -21,7 +23,7 @@ TESTS = \
|
|||
t/chkstow.t
|
||||
|
||||
AUTOMAKE_OPTIONS = dist-shar
|
||||
EXTRA_DIST = $(TESTS) t/util.pm stow.in
|
||||
EXTRA_DIST = $(TESTS) t/testutil.pm
|
||||
CLEANFILES = $(bin_SCRIPTS)
|
||||
|
||||
# clean up files left behind by test suite
|
||||
|
|
@ -30,7 +32,6 @@ clean-local:
|
|||
|
||||
# this is more explicit and reliable than the config file trick
|
||||
edit = sed -e 's|[@]PERL[@]|$(PERL)|g' \
|
||||
-e 's|[@]PACKAGE[@]|$(PACKAGE)|g' \
|
||||
-e 's|[@]VERSION[@]|$(VERSION)|g'
|
||||
|
||||
stow: stow.in Makefile
|
||||
|
|
@ -41,6 +42,9 @@ chkstow: chkstow.in Makefile
|
|||
$(edit) < $< > $@
|
||||
chmod +x $@
|
||||
|
||||
lib/Stow.pm: lib/Stow.pm.in
|
||||
$(edit) < $< > $@
|
||||
|
||||
# The rules for manual.html and manual.texi are only used by
|
||||
# the developer
|
||||
manual.html: manual.texi
|
||||
|
|
@ -51,5 +55,7 @@ manual.texi: stow.texi
|
|||
-rm -f $@
|
||||
cp $< $@
|
||||
|
||||
test: stow chkstow
|
||||
perl -MTest::Harness -e 'runtests(@ARGV)' t/*.t
|
||||
MODULES = lib/Stow.pm lib/Stow/Util.pm
|
||||
|
||||
test: stow chkstow $(MODULES)
|
||||
perl -MTest::Harness -Ilib -It -Ibin -e 'runtests(@ARGV)' t/*.t
|
||||
|
|
|
|||
2
TODO
2
TODO
|
|
@ -1,5 +1,3 @@
|
|||
* Split core code into Stow.pm
|
||||
* Add use strict / warnings to tests
|
||||
* Honour .no-stow-folding and --no-folding
|
||||
* Support ignore lists in files
|
||||
*** Implement.
|
||||
|
|
|
|||
|
|
@ -15,5 +15,11 @@ then
|
|||
AC_MSG_WARN([WARNING: Perl not found; you must edit line 1 of 'stow'])
|
||||
fi
|
||||
|
||||
AC_ARG_WITH(
|
||||
pmdir,
|
||||
[ --with-pmdir=DIR perl modules are in DIR [[LIBDIR/perl5]]],
|
||||
[PMDIR=${withval}], [PMDIR=${libdir}/perl5]
|
||||
)
|
||||
|
||||
AC_CONFIG_FILES([Makefile])
|
||||
AC_OUTPUT
|
||||
|
|
|
|||
1675
lib/Stow.pm.in
Executable file
1675
lib/Stow.pm.in
Executable file
File diff suppressed because it is too large
Load diff
202
lib/Stow/Util.pm
Normal file
202
lib/Stow/Util.pm
Normal file
|
|
@ -0,0 +1,202 @@
|
|||
package Stow::Util;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Stow::Util - general utilities
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Stow::Util qw(debug set_debug_level error ...);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Supporting utility routines for L<Stow>.
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use POSIX qw(getcwd);
|
||||
|
||||
use base qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
error debug set_debug_level set_test_mode
|
||||
join_paths parent canon_path restore_cwd
|
||||
);
|
||||
|
||||
our $ProgramName = 'stow';
|
||||
|
||||
#############################################################################
|
||||
#
|
||||
# General Utilities: nothing stow specific here.
|
||||
#
|
||||
#############################################################################
|
||||
|
||||
=head1 IMPORTABLE SUBROUTINES
|
||||
|
||||
=head2 error($format, @args)
|
||||
|
||||
Outputs an error message in a consistent form and then dies.
|
||||
|
||||
=cut
|
||||
|
||||
sub error {
|
||||
my ($format, @args) = @_;
|
||||
die "$ProgramName: ERROR: " . sprintf($format, @args) . " ($!)\n";
|
||||
}
|
||||
|
||||
=head2 set_debug_level($level)
|
||||
|
||||
Sets verbosity level for C<debug()>.
|
||||
|
||||
=cut
|
||||
|
||||
our $debug_level = 0;
|
||||
|
||||
sub set_debug_level {
|
||||
my ($level) = @_;
|
||||
$debug_level = $level;
|
||||
}
|
||||
|
||||
=head2 set_test_mode($on_or_off)
|
||||
|
||||
Sets testmode on or off.
|
||||
|
||||
=cut
|
||||
|
||||
our $test_mode = 0;
|
||||
|
||||
sub set_test_mode {
|
||||
my ($on_or_off) = @_;
|
||||
if ($on_or_off) {
|
||||
$test_mode = 1;
|
||||
}
|
||||
else {
|
||||
$test_mode = 0;
|
||||
}
|
||||
}
|
||||
|
||||
=head2 debug($level, $msg)
|
||||
|
||||
Logs to STDERR based on C<$debug_level> setting. C<$level> is the
|
||||
minimum verbosity level required to output C<$msg>. All output is to
|
||||
STDERR to preserve backward compatibility, except for in test mode,
|
||||
when STDOUT is used instead. In test mode, the verbosity can be
|
||||
overridden via the C<TEST_VERBOSE> environment variable.
|
||||
|
||||
Verbosity rules:
|
||||
|
||||
=over 4
|
||||
|
||||
=item 0: errors only
|
||||
|
||||
=item >= 1: print operations: LINK/UNLINK/MKDIR/RMDIR
|
||||
|
||||
=item >= 2: print trace: stow/unstow package/contents/node
|
||||
|
||||
=item >= 3: print trace detail: "_this_ already points to _that_"
|
||||
|
||||
=item >= 4: debug helper routines
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub debug {
|
||||
my ($level, $msg) = @_;
|
||||
if ($debug_level >= $level) {
|
||||
if ($test_mode) {
|
||||
print "# $msg\n";
|
||||
}
|
||||
else {
|
||||
warn "$msg\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#===== METHOD ===============================================================
|
||||
# Name : join_paths()
|
||||
# Purpose : concatenates given paths
|
||||
# Parameters: path1, path2, ... => paths
|
||||
# Returns : concatenation of given paths
|
||||
# Throws : n/a
|
||||
# Comments : factors out redundant path elements:
|
||||
# : '//' => '/' and 'a/b/../c' => 'a/c'
|
||||
#============================================================================
|
||||
sub join_paths {
|
||||
my @paths = @_;
|
||||
|
||||
# weed out empty components and concatenate
|
||||
my $result = join '/', grep {!/\A\z/} @paths;
|
||||
|
||||
# factor out back references and remove redundant /'s)
|
||||
my @result = ();
|
||||
PART:
|
||||
for my $part (split m{/+}, $result) {
|
||||
next PART if $part eq '.';
|
||||
if (@result && $part eq '..' && $result[-1] ne '..') {
|
||||
pop @result;
|
||||
}
|
||||
else {
|
||||
push @result, $part;
|
||||
}
|
||||
}
|
||||
|
||||
return join '/', @result;
|
||||
}
|
||||
|
||||
#===== METHOD ===============================================================
|
||||
# Name : parent
|
||||
# Purpose : find the parent of the given path
|
||||
# Parameters: @path => components of the path
|
||||
# Returns : returns a path string
|
||||
# Throws : n/a
|
||||
# Comments : allows you to send multiple chunks of the path
|
||||
# : (this feature is currently not used)
|
||||
#============================================================================
|
||||
sub parent {
|
||||
my @path = @_;
|
||||
my $path = join '/', @_;
|
||||
my @elts = split m{/+}, $path;
|
||||
pop @elts;
|
||||
return join '/', @elts;
|
||||
}
|
||||
|
||||
#===== METHOD ===============================================================
|
||||
# Name : canon_path
|
||||
# Purpose : find absolute canonical path of given path
|
||||
# Parameters: $path
|
||||
# Returns : absolute canonical path
|
||||
# Throws : n/a
|
||||
# Comments : is this significantly different from File::Spec->rel2abs?
|
||||
#============================================================================
|
||||
sub canon_path {
|
||||
my ($path) = @_;
|
||||
|
||||
my $cwd = getcwd();
|
||||
chdir($path) or error("canon_path: cannot chdir to $path from $cwd");
|
||||
my $canon_path = getcwd();
|
||||
restore_cwd($cwd);
|
||||
|
||||
return $canon_path;
|
||||
}
|
||||
|
||||
sub restore_cwd {
|
||||
my ($prev) = @_;
|
||||
chdir($prev) or error("Your current directory $prev seems to have vanished");
|
||||
}
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
|
||||
# Local variables:
|
||||
# mode: perl
|
||||
# cperl-indent-level: 4
|
||||
# end:
|
||||
# vim: ft=perl
|
||||
21
t/chkstow.t
21
t/chkstow.t
|
|
@ -4,22 +4,18 @@
|
|||
# Testing cleanup_invalid_links()
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN {
|
||||
use lib qw(.);
|
||||
require "t/util.pm";
|
||||
require "chkstow";
|
||||
}
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use testutil;
|
||||
require "chkstow";
|
||||
|
||||
use Test::More tests => 7;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
### setup
|
||||
eval { remove_dir('t/target'); };
|
||||
make_dir('t/target');
|
||||
|
||||
chdir 't/target';
|
||||
make_fresh_stow_and_target_dirs();
|
||||
cd('t/target');
|
||||
|
||||
# setup stow directory
|
||||
make_dir('stow');
|
||||
|
|
@ -111,5 +107,6 @@ stdout_like(
|
|||
|
||||
@ARGV = ('-b',);
|
||||
process_options();
|
||||
ok($::Target == q{/usr/local},
|
||||
our $Target;
|
||||
ok($Target == q{/usr/local},
|
||||
"Default target is /usr/local/");
|
||||
|
|
|
|||
|
|
@ -4,64 +4,55 @@
|
|||
# Testing cleanup_invalid_links()
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(.); require "t/util.pm"; require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 3;
|
||||
use Test::More tests => 6;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
### setup
|
||||
eval { remove_dir('t/target'); };
|
||||
eval { remove_dir('t/stow'); };
|
||||
make_dir('t/target');
|
||||
make_dir('t/stow');
|
||||
use testutil;
|
||||
|
||||
chdir 't/target';
|
||||
$Stow_Path= '../stow';
|
||||
make_fresh_stow_and_target_dirs();
|
||||
cd('t/target');
|
||||
|
||||
my $stow;
|
||||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
#
|
||||
# nothing to clean in a simple tree
|
||||
#
|
||||
reset_state();
|
||||
|
||||
|
||||
make_dir('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1','../stow/pkg1/bin1');
|
||||
|
||||
cleanup_invalid_links('./');
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('./');
|
||||
is(
|
||||
scalar @Tasks, 0
|
||||
scalar($stow->get_tasks), 0
|
||||
=> 'nothing to clean'
|
||||
);
|
||||
|
||||
#
|
||||
# cleanup a bad link in a simple tree
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('bin2');
|
||||
make_dir('../stow/pkg2/bin2');
|
||||
make_file('../stow/pkg2/bin2/file2a');
|
||||
make_link('bin2/file2a','../../stow/pkg2/bin2/file2a');
|
||||
make_link('bin2/file2b','../../stow/pkg2/bin2/file2b');
|
||||
|
||||
cleanup_invalid_links('bin2');
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar @Tasks == 1 &&
|
||||
$Link_Task_For{'bin2/file2b'}->{'action'} eq 'remove'
|
||||
=> 'cleanup a bad link'
|
||||
);
|
||||
|
||||
#use Data::Dumper;
|
||||
#print Dumper(\@Tasks,\%Link_Task_For,\%Dir_Task_For);
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('bin2');
|
||||
is(scalar($stow->get_conflicts), 0, 'no conflicts cleaning up bad link');
|
||||
is(scalar($stow->get_tasks), 1, 'one task cleaning up bad link');
|
||||
is($stow->link_task_action('bin2/file2b'), 'remove', 'removal task for bad link');
|
||||
|
||||
#
|
||||
# dont cleanup a bad link not owned by stow
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('bin3');
|
||||
make_dir('../stow/pkg3/bin3');
|
||||
|
|
@ -69,11 +60,7 @@ make_file('../stow/pkg3/bin3/file3a');
|
|||
make_link('bin3/file3a','../../stow/pkg3/bin3/file3a');
|
||||
make_link('bin3/file3b','../../empty');
|
||||
|
||||
cleanup_invalid_links('bin3');
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar @Tasks == 0
|
||||
=> 'dont cleanup a bad link not owned by stow'
|
||||
);
|
||||
|
||||
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('bin3');
|
||||
is(scalar($stow->get_conflicts), 0, 'no conflicts cleaning up bad link not owned by stow');
|
||||
is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
|
||||
|
|
|
|||
24
t/defer.t
Normal file → Executable file
24
t/defer.t
Normal file → Executable file
|
|
@ -4,19 +4,23 @@
|
|||
# Testing defer().
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(. ..); require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use testutil;
|
||||
|
||||
use Test::More tests => 4;
|
||||
|
||||
$Option{'defer'} = [ 'man' ];
|
||||
ok(defer('man/man1/file.1') => 'simple success');
|
||||
my $stow;
|
||||
|
||||
$Option{'defer'} = [ 'lib' ];
|
||||
ok(!defer('man/man1/file.1') => 'simple failure');
|
||||
$stow = new_Stow(defer => [ 'man' ]);
|
||||
ok($stow->defer('man/man1/file.1') => 'simple success');
|
||||
|
||||
$Option{'defer'} = [ 'lib', 'man', 'share' ];
|
||||
ok(defer('man/man1/file.1') => 'complex success');
|
||||
$stow = new_Stow(defer => [ 'lib' ]);
|
||||
ok(! $stow->defer('man/man1/file.1') => 'simple failure');
|
||||
|
||||
$Option{'defer'} = [ 'lib', 'man', 'share' ];
|
||||
ok(!defer('bin/file') => 'complex failure');
|
||||
$stow = new_Stow(defer => [ 'lib', 'man', 'share' ]);
|
||||
ok($stow->defer('man/man1/file.1') => 'complex success');
|
||||
|
||||
$stow = new_Stow(defer => [ 'lib', 'man', 'share' ]);
|
||||
ok(! $stow->defer('bin/file') => 'complex failure');
|
||||
|
|
|
|||
76
t/examples.t
76
t/examples.t
|
|
@ -4,18 +4,18 @@
|
|||
# Testing examples from the documentation
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(.); require "t/util.pm"; require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 4;
|
||||
use testutil;
|
||||
|
||||
use Test::More tests => 10;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
### setup
|
||||
eval { remove_dir('t/target'); };
|
||||
make_dir('t/target/stow');
|
||||
make_fresh_stow_and_target_dirs();
|
||||
cd('t/target');
|
||||
|
||||
chdir 't/target';
|
||||
$Stow_Path= 'stow';
|
||||
my $stow;
|
||||
|
||||
## set up some fake packages to stow
|
||||
|
||||
|
|
@ -42,8 +42,6 @@ make_file('stow/emacs/man/man1/emacs.1');
|
|||
#
|
||||
# stow perl into an empty target
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('stow/perl/bin');
|
||||
make_file('stow/perl/bin/perl');
|
||||
make_file('stow/perl/bin/a2p');
|
||||
|
|
@ -52,10 +50,11 @@ make_dir('stow/perl/lib/perl');
|
|||
make_dir('stow/perl/man/man1');
|
||||
make_file('stow/perl/man/man1/perl.1');
|
||||
|
||||
stow_contents('stow/perl','./','stow/perl');
|
||||
process_tasks();
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
$stow->plan_stow('perl');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'bin' && -l 'info' && -l 'lib' && -l 'man' &&
|
||||
readlink('bin') eq 'stow/perl/bin' &&
|
||||
readlink('info') eq 'stow/perl/info' &&
|
||||
|
|
@ -64,11 +63,9 @@ ok(
|
|||
=> 'stow perl into an empty target'
|
||||
);
|
||||
|
||||
|
||||
#
|
||||
# stow perl into a non-empty target
|
||||
#
|
||||
reset_state();
|
||||
|
||||
# clean up previous stow
|
||||
remove_link('bin');
|
||||
|
|
@ -80,10 +77,11 @@ make_dir('bin');
|
|||
make_dir('lib');
|
||||
make_dir('man/man1');
|
||||
|
||||
stow_contents('stow/perl','./','stow/perl');
|
||||
process_tasks();
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
$stow->plan_stow('perl');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-d 'bin' && -d 'lib' && -d 'man' && -d 'man/man1' &&
|
||||
-l 'info' && -l 'bin/perl' && -l 'bin/a2p' &&
|
||||
-l 'lib/perl' && -l 'man/man1/perl.1' &&
|
||||
|
|
@ -99,7 +97,6 @@ ok(
|
|||
#
|
||||
# Install perl into an empty target and then install emacs
|
||||
#
|
||||
reset_state();
|
||||
|
||||
# clean up previous stow
|
||||
remove_link('info');
|
||||
|
|
@ -107,11 +104,11 @@ remove_dir('bin');
|
|||
remove_dir('lib');
|
||||
remove_dir('man');
|
||||
|
||||
stow_contents('stow/perl', './','stow/perl');
|
||||
stow_contents('stow/emacs','./','stow/emacs');
|
||||
process_tasks();
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
$stow->plan_stow('perl', 'emacs');
|
||||
$stow->process_tasks();
|
||||
is(scalar($stow->get_conflicts), 0, 'no conflicts');
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
-d 'bin' &&
|
||||
-l 'bin/perl' &&
|
||||
-l 'bin/emacs' &&
|
||||
|
|
@ -151,30 +148,22 @@ ok(
|
|||
# Q. the original empty directory should remain
|
||||
# behaviour is the same as if the empty directory had nothing to do with stow
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('stow/pkg1a/bin1');
|
||||
make_dir('stow/pkg1b/bin1');
|
||||
make_file('stow/pkg1b/bin1/file1b');
|
||||
|
||||
stow_contents('stow/pkg1a', './', 'stow/pkg1a');
|
||||
stow_contents('stow/pkg1b', './', 'stow/pkg1b');
|
||||
unstow_contents('stow/pkg1b', './', 'stow/pkg1b');
|
||||
process_tasks();
|
||||
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
-d 'bin1'
|
||||
=> 'bug 1: stowing empty dirs'
|
||||
);
|
||||
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
$stow->plan_stow('pkg1a', 'pkg1b');
|
||||
$stow->plan_unstow('pkg1b');
|
||||
$stow->process_tasks();
|
||||
is(scalar($stow->get_conflicts), 0, 'no conflicts stowing empty dirs');
|
||||
ok(-d 'bin1' => 'bug 1: stowing empty dirs');
|
||||
|
||||
#
|
||||
# BUG 2: split open tree-folding symlinks pointing inside different stow
|
||||
# directories
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('stow2a/pkg2a/bin2');
|
||||
make_file('stow2a/pkg2a/bin2/file2a');
|
||||
make_file('stow2a/.stow');
|
||||
|
|
@ -182,8 +171,15 @@ make_dir('stow2b/pkg2b/bin2');
|
|||
make_file('stow2b/pkg2b/bin2/file2b');
|
||||
make_file('stow2b/.stow');
|
||||
|
||||
stow_contents('stow2a/pkg2a','./', 'stow2a/pkg2a');
|
||||
stow_contents('stow2b/pkg2b','./', 'stow2b/pkg2b');
|
||||
process_tasks();
|
||||
$stow = new_Stow(dir => 'stow2a');
|
||||
$stow->plan_stow('pkg2a');
|
||||
$stow->set_stow_dir('stow2b');
|
||||
$stow->plan_stow('pkg2b');
|
||||
$stow->process_tasks();
|
||||
|
||||
is(scalar($stow->get_conflicts), 0, 'no conflicts splitting tree-folding symlinks');
|
||||
ok(-d 'bin2' => 'tree got split by packages from multiple stow directories');
|
||||
ok(-f 'bin2/file2a' => 'file from 1st stow dir');
|
||||
ok(-f 'bin2/file2b' => 'file from 2nd stow dir');
|
||||
|
||||
## Finish this test
|
||||
|
|
|
|||
40
t/find_stowed_path.t
Normal file → Executable file
40
t/find_stowed_path.t
Normal file → Executable file
|
|
@ -4,39 +4,43 @@
|
|||
# Testing find_stowed_path()
|
||||
#
|
||||
|
||||
BEGIN { require "t/util.pm"; require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 5;
|
||||
use testutil;
|
||||
|
||||
eval { remove_dir('t/target'); };
|
||||
eval { remove_dir('t/stow'); };
|
||||
make_dir('t/target');
|
||||
make_dir('t/stow');
|
||||
use Test::More tests => 6;
|
||||
|
||||
make_fresh_stow_and_target_dirs();
|
||||
|
||||
my $stow = new_Stow(dir => 't/stow');
|
||||
|
||||
$Stow_Path = 't/stow';
|
||||
is(
|
||||
find_stowed_path('t/target/a/b/c', '../../../stow/a/b/c'),
|
||||
$stow->find_stowed_path('t/target/a/b/c', '../../../stow/a/b/c'),
|
||||
't/stow/a/b/c',
|
||||
=> 'from root'
|
||||
);
|
||||
|
||||
$Stow_Path = '../stow';
|
||||
cd('t/target');
|
||||
$stow->set_stow_dir('../stow');
|
||||
is(
|
||||
find_stowed_path('a/b/c','../../../stow/a/b/c'),
|
||||
$stow->find_stowed_path('a/b/c','../../../stow/a/b/c'),
|
||||
'../stow/a/b/c',
|
||||
=> 'from target directory'
|
||||
);
|
||||
|
||||
$Stow_Path = 't/target/stow';
|
||||
make_dir('stow');
|
||||
cd('../..');
|
||||
$stow->set_stow_dir('t/target/stow');
|
||||
|
||||
is(
|
||||
find_stowed_path('t/target/a/b/c', '../../stow/a/b/c'),
|
||||
$stow->find_stowed_path('t/target/a/b/c', '../../stow/a/b/c'),
|
||||
't/target/stow/a/b/c',
|
||||
=> 'stow is subdir of target directory'
|
||||
);
|
||||
|
||||
is(
|
||||
find_stowed_path('t/target/a/b/c','../../empty'),
|
||||
$stow->find_stowed_path('t/target/a/b/c','../../empty'),
|
||||
'',
|
||||
=> 'target is not stowed'
|
||||
);
|
||||
|
|
@ -45,7 +49,15 @@ make_dir('t/target/stow2');
|
|||
make_file('t/target/stow2/.stow');
|
||||
|
||||
is(
|
||||
find_stowed_path('t/target/a/b/c','../../stow2/a/b/c'),
|
||||
$stow->find_stowed_path('t/target/a/b/c','../../stow2/a/b/c'),
|
||||
't/target/stow2/a/b/c'
|
||||
=> 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','../../..'),
|
||||
''
|
||||
=> q(corner case - link points to ancestor of stow dir)
|
||||
);
|
||||
|
|
|
|||
25
t/foldable.t
25
t/foldable.t
|
|
@ -4,21 +4,18 @@
|
|||
# Testing foldable()
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(.); require "t/util.pm"; require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use testutil;
|
||||
|
||||
use Test::More tests => 4;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
### setup
|
||||
# be very careful with these
|
||||
eval { remove_dir('t/target'); };
|
||||
eval { remove_dir('t/stow'); };
|
||||
make_dir('t/target');
|
||||
make_dir('t/stow');
|
||||
make_fresh_stow_and_target_dirs();
|
||||
cd('t/target');
|
||||
|
||||
chdir 't/target';
|
||||
$Stow_Path= '../stow';
|
||||
my $stow = new_Stow(dir => '../stow');
|
||||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
|
|
@ -31,7 +28,7 @@ make_file('../stow/pkg1/bin1/file1');
|
|||
make_dir('bin1');
|
||||
make_link('bin1/file1','../../stow/pkg1/bin1/file1');
|
||||
|
||||
is( foldable('bin1'), '../stow/pkg1/bin1' => q(can fold a simple tree) );
|
||||
is( $stow->foldable('bin1'), '../stow/pkg1/bin1' => q(can fold a simple tree) );
|
||||
|
||||
#
|
||||
# can't fold an empty directory
|
||||
|
|
@ -41,7 +38,7 @@ make_dir('../stow/pkg2/bin2');
|
|||
make_file('../stow/pkg2/bin2/file2');
|
||||
make_dir('bin2');
|
||||
|
||||
is( foldable('bin2'), '' => q(can't fold an empty directory) );
|
||||
is( $stow->foldable('bin2'), '' => q(can't fold an empty directory) );
|
||||
|
||||
#
|
||||
# can't fold if dir contains a non-link
|
||||
|
|
@ -53,7 +50,7 @@ make_dir('bin3');
|
|||
make_link('bin3/file3','../../stow/pkg3/bin3/file3');
|
||||
make_file('bin3/non-link');
|
||||
|
||||
is( foldable('bin3'), '' => q(can't fold a dir containing non-links) );
|
||||
is( $stow->foldable('bin3'), '' => q(can't fold a dir containing non-links) );
|
||||
|
||||
#
|
||||
# can't fold if links point to different directories
|
||||
|
|
@ -67,4 +64,4 @@ make_dir('../stow/pkg4b/bin4');
|
|||
make_file('../stow/pkg4b/bin4/file4b');
|
||||
make_link('bin4/file4b','../../stow/pkg4b/bin4/file4b');
|
||||
|
||||
is( foldable('bin4'), '' => q(can't fold if links point to different dirs) );
|
||||
is( $stow->foldable('bin4'), '' => q(can't fold if links point to different dirs) );
|
||||
|
|
|
|||
6
t/join_paths.t
Normal file → Executable file
6
t/join_paths.t
Normal file → Executable file
|
|
@ -4,8 +4,10 @@
|
|||
# Testing join_paths();
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(. ..); require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Stow::Util qw(join_paths);
|
||||
|
||||
use Test::More tests => 13;
|
||||
|
||||
|
|
|
|||
6
t/parent.t
Normal file → Executable file
6
t/parent.t
Normal file → Executable file
|
|
@ -4,8 +4,10 @@
|
|||
# Testing parent()
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(. ..); require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Stow::Util qw(parent);
|
||||
|
||||
use Test::More tests => 5;
|
||||
|
||||
|
|
|
|||
66
t/stow.t
66
t/stow.t
|
|
@ -4,11 +4,17 @@
|
|||
# Testing core application
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(.); require "t/util.pm"; require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 10;
|
||||
|
||||
use testutil;
|
||||
|
||||
require 'stow';
|
||||
|
||||
make_fresh_stow_and_target_dirs();
|
||||
|
||||
local @ARGV = (
|
||||
'-v',
|
||||
'-d t/stow',
|
||||
|
|
@ -16,23 +22,19 @@ local @ARGV = (
|
|||
'dummy'
|
||||
);
|
||||
|
||||
### setup
|
||||
eval { remove_dir('t/target'); };
|
||||
eval { remove_dir('t/stow'); };
|
||||
make_dir('t/target');
|
||||
make_dir('t/stow');
|
||||
my ($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
|
||||
|
||||
ok eval {process_options(); 1} => 'process options';
|
||||
ok eval {set_stow_path(); 1} => 'set stow path';
|
||||
is($options->{verbose}, 1, 'verbose option');
|
||||
is($options->{dir}, 't/stow', 'stow dir option');
|
||||
|
||||
is($Stow_Path,"../stow" => 'stow dir');
|
||||
is_deeply(\@Pkgs_To_Stow, [ 'dummy' ] => 'default to stow');
|
||||
my $stow = new_Stow(%$options);
|
||||
|
||||
is($stow->{stow_path}, "../stow" => 'stow dir');
|
||||
is_deeply($pkgs_to_stow, [ 'dummy' ] => 'default to stow');
|
||||
|
||||
#
|
||||
# Check mixed up package options
|
||||
#
|
||||
%Option=();
|
||||
local @ARGV = (
|
||||
'-v',
|
||||
'-D', 'd1', 'd2',
|
||||
|
|
@ -43,55 +45,53 @@ local @ARGV = (
|
|||
'-R', 'r2',
|
||||
);
|
||||
|
||||
@Pkgs_To_Stow = ();
|
||||
@Pkgs_To_Delete = ();
|
||||
process_options();
|
||||
is_deeply(\@Pkgs_To_Delete, [ 'd1', 'd2', 'r1', 'd3', 'r2' ] => 'mixed deletes');
|
||||
is_deeply(\@Pkgs_To_Stow, [ 's1', 'r1', 's2', 's3', 'r2' ] => 'mixed stows');
|
||||
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
|
||||
is_deeply($pkgs_to_delete, [ 'd1', 'd2', 'r1', 'd3', 'r2' ] => 'mixed deletes');
|
||||
is_deeply($pkgs_to_stow, [ 's1', 'r1', 's2', 's3', 'r2' ] => 'mixed stows');
|
||||
|
||||
#
|
||||
# Check setting defered paths
|
||||
# Check setting deferred paths
|
||||
#
|
||||
%Option=();
|
||||
local @ARGV = (
|
||||
'--defer=man',
|
||||
'--defer=info'
|
||||
'--defer=info',
|
||||
'dummy'
|
||||
);
|
||||
process_options();
|
||||
is_deeply($Option{'defer'}, [ qr(\Aman), qr(\Ainfo) ] => 'defer man and info');
|
||||
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
|
||||
is_deeply($options->{'defer'}, [ qr(\Aman), qr(\Ainfo) ] => 'defer man and info');
|
||||
|
||||
#
|
||||
# Check setting override paths
|
||||
#
|
||||
%Option=();
|
||||
local @ARGV = (
|
||||
'--override=man',
|
||||
'--override=info'
|
||||
'--override=info',
|
||||
'dummy'
|
||||
);
|
||||
process_options();
|
||||
is_deeply($Option{'override'}, [qr(\Aman), qr(\Ainfo)] => 'override man and info');
|
||||
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
|
||||
is_deeply($options->{'override'}, [qr(\Aman), qr(\Ainfo)] => 'override man and info');
|
||||
|
||||
#
|
||||
# Check stripping any matched quotes
|
||||
#
|
||||
%Option=();
|
||||
local @ARGV = (
|
||||
"--override='man'",
|
||||
'--override="info"',
|
||||
'dummy'
|
||||
);
|
||||
process_options();
|
||||
is_deeply($Option{'override'}, [qr(\Aman), qr(\Ainfo)] => 'strip shell quoting');
|
||||
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
|
||||
is_deeply($options->{'override'}, [qr(\Aman), qr(\Ainfo)] => 'strip shell quoting');
|
||||
|
||||
#
|
||||
# Check setting ignored paths
|
||||
#
|
||||
%Option=();
|
||||
local @ARGV = (
|
||||
'--ignore="~"',
|
||||
'--ignore="\.#.*"'
|
||||
'--ignore="\.#.*"',
|
||||
'dummy'
|
||||
);
|
||||
process_options();
|
||||
is_deeply($Option{'ignore'}, [ qr(~\z), qr(\.#.*\z) ] => 'ignore temp files');
|
||||
($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
|
||||
is_deeply($options->{'ignore'}, [ qr(~\z), qr(\.#.*\z) ] => 'ignore temp files');
|
||||
|
||||
|
||||
# vim:ft=perl
|
||||
|
|
|
|||
|
|
@ -1,36 +1,37 @@
|
|||
#!/usr/local/bin/perl
|
||||
|
||||
#
|
||||
# Testing
|
||||
# Testing stow_contents()
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(.); require "t/util.pm"; require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 16;
|
||||
use Test::More tests => 19;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
### setup
|
||||
eval { remove_dir('t/target'); };
|
||||
eval { remove_dir('t/stow'); };
|
||||
make_dir('t/target');
|
||||
make_dir('t/stow');
|
||||
use testutil;
|
||||
|
||||
chdir 't/target';
|
||||
$Stow_Path= '../stow';
|
||||
make_fresh_stow_and_target_dirs();
|
||||
cd('t/target');
|
||||
|
||||
my $stow;
|
||||
my @conflicts;
|
||||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
#
|
||||
# stow a simple tree minimally
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow(dir => '../stow');
|
||||
|
||||
make_dir('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
stow_contents('../stow/pkg1', './', '../stow/pkg1');
|
||||
process_tasks();
|
||||
|
||||
$stow->plan_stow('pkg1');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflicts(), 0, 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink('bin1'),
|
||||
'../stow/pkg1/bin1',
|
||||
|
|
@ -40,13 +41,13 @@ is(
|
|||
#
|
||||
# stow a simple tree into an existing directory
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_dir('lib2');
|
||||
stow_contents('../stow/pkg2', '.', '../stow/pkg2');
|
||||
process_tasks();
|
||||
$stow->plan_stow('pkg2');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('lib2/file2'),
|
||||
'../../stow/pkg2/lib2/file2',
|
||||
|
|
@ -56,7 +57,7 @@ is(
|
|||
#
|
||||
# unfold existing tree
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('../stow/pkg3a/bin3');
|
||||
make_file('../stow/pkg3a/bin3/file3a');
|
||||
|
|
@ -64,8 +65,8 @@ make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
|
|||
|
||||
make_dir('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
stow_contents('../stow/pkg3b', './', '../stow/pkg3b');
|
||||
process_tasks();
|
||||
$stow->plan_stow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
-d 'bin3' &&
|
||||
readlink('bin3/file3a') eq '../../stow/pkg3a/bin3/file3a' &&
|
||||
|
|
@ -74,42 +75,45 @@ ok(
|
|||
);
|
||||
|
||||
#
|
||||
# Link to a new dir conflicts with existing non-dir (can't unfold)
|
||||
# Link to a new dir conflicts with existing non-dir (can't unfold)
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_file('bin4'); # this is a file but named like a directory
|
||||
make_dir('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
stow_contents('../stow/pkg4', './', '../stow/pkg4');
|
||||
like(
|
||||
$Conflicts[-1], qr(CONFLICT:.*existing target is neither a link nor a directory)
|
||||
$stow->plan_stow('pkg4');
|
||||
@conflicts = $stow->get_conflicts();
|
||||
like(
|
||||
$conflicts[-1], qr(CONFLICT:.*existing target is neither a link nor a directory)
|
||||
=> 'link to new dir conflicts with existing non-directory'
|
||||
);
|
||||
|
||||
#
|
||||
# Target already exists but is not owned by stow
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('bin5');
|
||||
make_link('bin5/file5','../../empty');
|
||||
make_dir('../stow/pkg5/bin5/file5');
|
||||
stow_contents('../stow/pkg5', './', '../stow/pkg5');
|
||||
$stow->plan_stow('pkg5');
|
||||
@conflicts = $stow->get_conflicts();
|
||||
like(
|
||||
$Conflicts[-1], qr(CONFLICT:.*not owned by stow)
|
||||
$conflicts[-1], qr(CONFLICT:.*not owned by stow)
|
||||
=> 'target already exists but is not owned by stow'
|
||||
);
|
||||
|
||||
#
|
||||
# Replace existing but invalid target
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_link('file6','../stow/path-does-not-exist');
|
||||
make_dir('../stow/pkg6');
|
||||
make_file('../stow/pkg6/file6');
|
||||
eval{ stow_contents('../stow/pkg6', './', '../stow/pkg6'); process_tasks() };
|
||||
$stow->plan_stow('pkg6');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('file6'),
|
||||
'../stow/pkg6/file6'
|
||||
|
|
@ -120,7 +124,7 @@ is(
|
|||
# Target already exists, is owned by stow, but points to a non-directory
|
||||
# (can't unfold)
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('bin7');
|
||||
make_dir('../stow/pkg7a/bin7');
|
||||
|
|
@ -128,16 +132,17 @@ make_file('../stow/pkg7a/bin7/node7');
|
|||
make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
|
||||
make_dir('../stow/pkg7b/bin7/node7');
|
||||
make_file('../stow/pkg7b/bin7/node7/file7');
|
||||
stow_contents('../stow/pkg7b', './', '../stow/pkg7b');
|
||||
like(
|
||||
$Conflicts[-1], qr(CONFLICT:.*existing target is stowed to a different package)
|
||||
$stow->plan_stow('pkg7b');
|
||||
@conflicts = $stow->get_conflicts();
|
||||
like(
|
||||
$conflicts[-1], qr(CONFLICT:.*existing target is stowed to a different package)
|
||||
=> 'link to new dir conflicts with existing stowed non-directory'
|
||||
);
|
||||
|
||||
#
|
||||
# stowing directories named 0
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('../stow/pkg8a/0');
|
||||
make_file('../stow/pkg8a/0/file8a');
|
||||
|
|
@ -145,10 +150,10 @@ make_link('0' => '../stow/pkg8a/0'); # emulate stow
|
|||
|
||||
make_dir('../stow/pkg8b/0');
|
||||
make_file('../stow/pkg8b/0/file8b');
|
||||
stow_contents('../stow/pkg8b', './', '../stow/pkg8b');
|
||||
process_tasks();
|
||||
$stow->plan_stow('pkg8b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-d '0' &&
|
||||
readlink('0/file8a') eq '../../stow/pkg8a/0/file8a' &&
|
||||
readlink('0/file8b') eq '../../stow/pkg8b/0/file8b'
|
||||
|
|
@ -158,8 +163,7 @@ ok(
|
|||
#
|
||||
# overriding already stowed documentation
|
||||
#
|
||||
reset_state();
|
||||
$Option{'override'} = ['man9', 'info9'];
|
||||
$stow = new_Stow(override => ['man9', 'info9']);
|
||||
|
||||
make_dir('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
|
|
@ -168,10 +172,10 @@ make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emu
|
|||
|
||||
make_dir('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
stow_contents('../stow/pkg9b', './', '../stow/pkg9b');
|
||||
process_tasks();
|
||||
$stow->plan_stow('pkg9b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
readlink('man9/man1/file9.1') eq '../../../stow/pkg9b/man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
|
|
@ -179,8 +183,7 @@ ok(
|
|||
#
|
||||
# deferring to already stowed documentation
|
||||
#
|
||||
reset_state();
|
||||
$Option{'defer'} = ['man10', 'info10'];
|
||||
$stow = new_Stow(defer => ['man10', 'info10']);
|
||||
|
||||
make_dir('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10.1');
|
||||
|
|
@ -189,14 +192,15 @@ make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1');
|
|||
|
||||
make_dir('../stow/pkg10b/man10/man1');
|
||||
make_file('../stow/pkg10b/man10/man1/file10.1');
|
||||
stow_contents('../stow/pkg10b', './', '../stow/pkg10b');
|
||||
$stow->plan_stow('pkg10b');
|
||||
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
readlink('man10/man1/file10.1') eq '../../../stow/pkg10a/man10/man1/file10.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
|
|
@ -204,8 +208,7 @@ ok(
|
|||
#
|
||||
# Ignore temp files
|
||||
#
|
||||
reset_state();
|
||||
$Option{'ignore'} = ['~', '\.#.*'];
|
||||
$stow = new_Stow(ignore => ['~', '\.#.*']);
|
||||
|
||||
make_dir('../stow/pkg11/man11/man1');
|
||||
make_file('../stow/pkg11/man11/man1/file11.1');
|
||||
|
|
@ -213,10 +216,10 @@ make_file('../stow/pkg11/man11/man1/file11.1~');
|
|||
make_file('../stow/pkg11/man11/man1/.#file11.1');
|
||||
make_dir('man11/man1');
|
||||
|
||||
stow_contents('../stow/pkg11', './', '../stow/pkg11');
|
||||
process_tasks();
|
||||
$stow->plan_stow('pkg11');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
readlink('man11/man1/file11.1') eq '../../../stow/pkg11/man11/man1/file11.1' &&
|
||||
!-e 'man11/man1/file11.1~' &&
|
||||
!-e 'man11/man1/.#file11.1'
|
||||
|
|
@ -226,17 +229,17 @@ ok(
|
|||
#
|
||||
# stowing links library files
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('../stow/pkg12/lib12/');
|
||||
make_file('../stow/pkg12/lib12/lib.so');
|
||||
make_link('../stow/pkg12/lib12/lib.so.1','lib.so');
|
||||
|
||||
make_dir('lib12/');
|
||||
stow_contents('../stow/pkg12', './', '../stow/pkg12');
|
||||
process_tasks();
|
||||
$stow->plan_stow('pkg12');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
readlink('lib12/lib.so.1') eq '../../stow/pkg12/lib12/lib.so.1'
|
||||
=> 'stow links to libraries'
|
||||
);
|
||||
|
|
@ -244,7 +247,7 @@ ok(
|
|||
#
|
||||
# unfolding to stow links to library files
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('../stow/pkg13a/lib13/');
|
||||
make_file('../stow/pkg13a/lib13/liba.so');
|
||||
|
|
@ -255,10 +258,10 @@ make_dir('../stow/pkg13b/lib13/');
|
|||
make_file('../stow/pkg13b/lib13/libb.so');
|
||||
make_link('../stow/pkg13b/lib13/libb.so.1', 'libb.so');
|
||||
|
||||
stow_contents('../stow/pkg13b', './', '../stow/pkg13b');
|
||||
process_tasks();
|
||||
$stow->plan_stow('pkg13b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
readlink('lib13/liba.so.1') eq '../../stow/pkg13a/lib13/liba.so.1' &&
|
||||
readlink('lib13/libb.so.1') eq '../../stow/pkg13b/lib13/libb.so.1'
|
||||
=> 'unfolding to stow links to libraries'
|
||||
|
|
@ -267,20 +270,38 @@ ok(
|
|||
#
|
||||
# stowing to stow dir should fail
|
||||
#
|
||||
reset_state();
|
||||
$Stow_Path= 'stow';
|
||||
make_dir('stow');
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
|
||||
make_dir('stow/pkg14/stow/pkg15');
|
||||
make_file('stow/pkg14/stow/pkg15/node15');
|
||||
|
||||
stow_contents('stow/pkg14', '.', 'stow/pkg14');
|
||||
$stow->plan_stow('pkg14');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
! -l 'stow/pkg15'
|
||||
=> "stowing to stow dir should fail"
|
||||
);
|
||||
|
||||
#
|
||||
# stow a simple tree minimally when cwd isn't target
|
||||
#
|
||||
cd('../..');
|
||||
$stow = new_Stow(dir => 't/stow', target => 't/target');
|
||||
|
||||
make_dir('t/stow/pkg16/bin16');
|
||||
make_file('t/stow/pkg16/bin16/file16');
|
||||
|
||||
$stow->plan_stow('pkg16');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflicts(), 0, 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink('t/target/bin16'),
|
||||
'../stow/pkg16/bin16',
|
||||
=> 'minimal stow of a simple tree'
|
||||
);
|
||||
|
|
|
|||
|
|
@ -7,22 +7,31 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Stow;
|
||||
use Stow::Util qw(parent);
|
||||
|
||||
#===== SUBROUTINE ===========================================================
|
||||
# Name : reset_state()
|
||||
# Purpose : reset internal state machine
|
||||
# Parameters: none
|
||||
# Returns : n/a
|
||||
# Throws : n/a
|
||||
# Comments : none
|
||||
#============================================================================
|
||||
sub reset_state {
|
||||
@::Tasks = ();
|
||||
@::Conflicts = ();
|
||||
%::Link_Task_For = ();
|
||||
%::Dir_Task_For = ();
|
||||
%::Option = ( testmode => 1 );
|
||||
return;
|
||||
sub make_fresh_stow_and_target_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); };
|
||||
make_dir($dir);
|
||||
}
|
||||
}
|
||||
|
||||
sub new_Stow {
|
||||
my %opts = @_;
|
||||
$opts{dir} ||= '../stow';
|
||||
$opts{target} ||= '.';
|
||||
$opts{test_mode} = 1;
|
||||
return new Stow(%opts);
|
||||
}
|
||||
|
||||
sub new_compat_Stow {
|
||||
my %opts = @_;
|
||||
$opts{compat} = 1;
|
||||
return new_Stow(%opts);
|
||||
}
|
||||
|
||||
#===== SUBROUTINE ===========================================================
|
||||
|
|
@ -38,13 +47,13 @@ sub make_link {
|
|||
my ($target, $source) = @_;
|
||||
|
||||
if (-l $target) {
|
||||
my $old_source = readlink join('/',parent($target),$source)
|
||||
my $old_source = readlink join('/', parent($target), $source)
|
||||
or die "could not read link $target/$source";
|
||||
if ($old_source ne $source) {
|
||||
die "$target already exists but points elsewhere\n";
|
||||
}
|
||||
}
|
||||
elsif (-e $target ) {
|
||||
elsif (-e $target) {
|
||||
die "$target already exists and is not a link\n";
|
||||
}
|
||||
else {
|
||||
|
|
@ -56,7 +65,7 @@ sub make_link {
|
|||
|
||||
#===== SUBROUTINE ===========================================================
|
||||
# Name : make_dir()
|
||||
# Purpose : create a directory and any requiste parents
|
||||
# Purpose : create a directory and any requisite parents
|
||||
# Parameters: $dir => path to the new directory
|
||||
# Returns : n/a
|
||||
# Throws : fatal error if the directory or any of its parents cannot be
|
||||
|
|
@ -174,4 +183,23 @@ sub remove_dir {
|
|||
return;
|
||||
}
|
||||
|
||||
#===== SUBROUTINE ===========================================================
|
||||
# Name : cd()
|
||||
# Purpose : wrapper around chdir
|
||||
# Parameters: $dir => path to chdir to
|
||||
# Returns : n/a
|
||||
# Throws : fatal error if the chdir fails
|
||||
# Comments : none
|
||||
#============================================================================
|
||||
sub cd {
|
||||
my ($dir) = @_;
|
||||
chdir $dir or die "Failed to chdir($dir): $!\n";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# Local variables:
|
||||
# mode: perl
|
||||
# cperl-indent-level: 4
|
||||
# end:
|
||||
# vim: ft=perl
|
||||
|
|
@ -4,38 +4,36 @@
|
|||
# Testing unstow_contents()
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(.); require "t/util.pm"; require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 20;
|
||||
use testutil;
|
||||
|
||||
use Test::More tests => 21;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
### setup
|
||||
eval { remove_dir('t/target'); };
|
||||
eval { remove_dir('t/stow'); };
|
||||
make_dir('t/target');
|
||||
make_dir('t/stow');
|
||||
|
||||
chdir 't/target';
|
||||
$Stow_Path= '../stow';
|
||||
make_fresh_stow_and_target_dirs();
|
||||
cd('t/target');
|
||||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
my $stow;
|
||||
my @conflicts;
|
||||
|
||||
#
|
||||
# unstow a simple tree minimally
|
||||
#
|
||||
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1','../stow/pkg1/bin1');
|
||||
make_link('bin1', '../stow/pkg1/bin1');
|
||||
|
||||
unstow_contents('../stow/pkg1','.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg1');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-f '../stow/pkg1/bin1/file1' && ! -e 'bin1'
|
||||
=> 'unstow a simple tree'
|
||||
);
|
||||
|
|
@ -43,16 +41,16 @@ ok(
|
|||
#
|
||||
# unstow a simple tree from an existing directory
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('lib2');
|
||||
make_dir('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
|
||||
unstow_contents('../stow/pkg2','.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg2');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-f '../stow/pkg2/lib2/file2' && -d 'lib2'
|
||||
=> 'unstow simple tree from a pre-existing directory'
|
||||
);
|
||||
|
|
@ -60,7 +58,7 @@ ok(
|
|||
#
|
||||
# fold tree after unstowing
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('bin3');
|
||||
|
||||
|
|
@ -71,10 +69,10 @@ make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
|
|||
make_dir('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
|
||||
unstow_contents('../stow/pkg3b', '.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'bin3' &&
|
||||
readlink('bin3') eq '../stow/pkg3a/bin3'
|
||||
=> 'fold tree after unstowing'
|
||||
|
|
@ -83,17 +81,17 @@ ok(
|
|||
#
|
||||
# existing link is owned by stow but is invalid so it gets removed anyway
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('bin4');
|
||||
make_dir('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
make_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
|
||||
|
||||
unstow_contents('../stow/pkg4', '.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg4');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
! -e 'bin4/file4'
|
||||
=> q(remove invalid link owned by stow)
|
||||
);
|
||||
|
|
@ -101,20 +99,22 @@ ok(
|
|||
#
|
||||
# Existing link is not owned by stow
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('../stow/pkg5/bin5');
|
||||
make_link('bin5', '../not-stow');
|
||||
|
||||
unstow_contents('../stow/pkg5', '.');
|
||||
$stow->plan_unstow('pkg5');
|
||||
@conflicts = $stow->get_conflicts;
|
||||
like(
|
||||
$Conflicts[-1], qr(CONFLICT:.*existing target is not owned by stow)
|
||||
$conflicts[-1], qr(CONFLICT:.*existing target is not owned by stow)
|
||||
=> q(existing link not owned by stow)
|
||||
);
|
||||
|
||||
#
|
||||
# Target already exists, is owned by stow, but points to a different package
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow();
|
||||
|
||||
make_dir('bin6');
|
||||
make_dir('../stow/pkg6a/bin6');
|
||||
|
|
@ -124,10 +124,10 @@ make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
|
|||
make_dir('../stow/pkg6b/bin6');
|
||||
make_file('../stow/pkg6b/bin6/file6');
|
||||
|
||||
unstow_contents('../stow/pkg6b', '.');
|
||||
$stow->plan_unstow('pkg6b');
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
-l 'bin6/file6' &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'bin6/file6' &&
|
||||
readlink('bin6/file6') eq '../../stow/pkg6a/bin6/file6'
|
||||
=> q(ignore existing link that points to a different package)
|
||||
);
|
||||
|
|
@ -135,24 +135,22 @@ ok(
|
|||
#
|
||||
# Don't unlink anything under the stow directory
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('stow'); # make out stow dir a subdir of target
|
||||
$Stow_Path = 'stow';
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_dir('stow/pkg7a/stow/pkg7b');
|
||||
make_file('stow/pkg7a/stow/pkg7b/file7b');
|
||||
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
|
||||
|
||||
unstow_contents('stow/pkg7b', '.');
|
||||
$stow->plan_unstow('pkg7b');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg7b'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'stow/pkg7b' &&
|
||||
readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
|
||||
=> q(don't unlink any nodes under the stow directory)
|
||||
|
|
@ -161,10 +159,7 @@ ok(
|
|||
#
|
||||
# Don't unlink any nodes under another stow directory
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('stow'); # make out stow dir a subdir of target
|
||||
$Stow_Path = 'stow';
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
|
||||
make_dir('stow2'); # make our alternate stow dir a subdir of target
|
||||
make_file('stow2/.stow');
|
||||
|
|
@ -174,14 +169,14 @@ make_dir('stow/pkg8a/stow2/pkg8b');
|
|||
make_file('stow/pkg8a/stow2/pkg8b/file8b');
|
||||
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
|
||||
|
||||
unstow_contents('stow/pkg8a', '.');
|
||||
$stow->plan_unstow('pkg8a');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg8a'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'stow2/pkg8b' &&
|
||||
readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
|
||||
=> q(don't unlink any nodes under another stow directory)
|
||||
|
|
@ -190,10 +185,8 @@ ok(
|
|||
#
|
||||
# overriding already stowed documentation
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_Stow(override => ['man9', 'info9']);
|
||||
make_file('stow/.stow');
|
||||
$Stow_Path = '../stow';
|
||||
$Option{'override'} = ['man9', 'info9'];
|
||||
|
||||
make_dir('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
|
|
@ -202,10 +195,10 @@ make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emu
|
|||
|
||||
make_dir('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
unstow_contents('../stow/pkg9b', '.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg9b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
!-l 'man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
|
|
@ -213,8 +206,7 @@ ok(
|
|||
#
|
||||
# deferring to already stowed documentation
|
||||
#
|
||||
reset_state();
|
||||
$Option{'defer'} = ['man10', 'info10'];
|
||||
$stow = new_Stow(defer => ['man10', 'info10']);
|
||||
|
||||
make_dir('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10a.1');
|
||||
|
|
@ -229,14 +221,14 @@ make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1'
|
|||
|
||||
make_dir('../stow/pkg10c/man10/man1');
|
||||
make_file('../stow/pkg10c/man10/man1/file10a.1');
|
||||
unstow_contents('../stow/pkg10c', '.');
|
||||
$stow->plan_unstow('pkg10c');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg10c'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
|
|
@ -244,8 +236,7 @@ ok(
|
|||
#
|
||||
# Ignore temp files
|
||||
#
|
||||
reset_state();
|
||||
$Option{'ignore'} = ['~', '\.#.*'];
|
||||
$stow = new_Stow(ignore => ['~', '\.#.*']);
|
||||
|
||||
make_dir('../stow/pkg12/man12/man1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1');
|
||||
|
|
@ -254,10 +245,10 @@ make_file('../stow/pkg12/man12/man1/.#file12.1');
|
|||
make_dir('man12/man1');
|
||||
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
|
||||
|
||||
unstow_contents('../stow/pkg12', '.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg12');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
!-e 'man12/man1/file12.1'
|
||||
=> 'ignore temp files'
|
||||
);
|
||||
|
|
@ -265,15 +256,15 @@ ok(
|
|||
#
|
||||
# Unstow an already unstowed package
|
||||
#
|
||||
reset_state();
|
||||
unstow_contents('../stow/pkg12', '.');
|
||||
$stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg12'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0
|
||||
scalar($stow->get_conflicts) == 0
|
||||
=> 'unstow already unstowed package pkg12'
|
||||
);
|
||||
|
||||
|
|
@ -284,15 +275,15 @@ ok(
|
|||
eval { remove_dir('t/target'); };
|
||||
mkdir('t/target');
|
||||
|
||||
reset_state();
|
||||
unstow_contents('../stow/pkg12', '.');
|
||||
$stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg12 which was never stowed'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0
|
||||
scalar($stow->get_conflicts) == 0
|
||||
=> 'unstow never stowed package pkg12'
|
||||
);
|
||||
|
||||
|
|
@ -301,19 +292,38 @@ ok(
|
|||
#
|
||||
make_file('man12/man1/file12.1');
|
||||
|
||||
reset_state();
|
||||
unstow_contents('../stow/pkg12', '.');
|
||||
$stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg12 for third time'
|
||||
);
|
||||
@conflicts = $stow->get_conflicts;
|
||||
ok(
|
||||
scalar(@Conflicts) == 1 &&
|
||||
$Conflicts[0] =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
|
||||
@conflicts == 1 &&
|
||||
$conflicts[0] =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
|
||||
=> 'unstow pkg12 for third time'
|
||||
);
|
||||
|
||||
#
|
||||
# unstow a simple tree minimally when cwd isn't target
|
||||
#
|
||||
cd('../..');
|
||||
$stow = new_Stow(dir => 't/stow', target => 't/target');
|
||||
|
||||
make_dir('t/stow/pkg13/bin13');
|
||||
make_file('t/stow/pkg13/bin13/file13');
|
||||
make_link('t/target/bin13', '../stow/pkg13/bin13');
|
||||
|
||||
$stow->plan_unstow('pkg13');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-f 't/stow/pkg13/bin13/file13' && ! -e 't/target/bin13'
|
||||
=> 'unstow a simple tree'
|
||||
);
|
||||
|
||||
|
||||
# Todo
|
||||
#
|
||||
|
|
|
|||
|
|
@ -4,38 +4,37 @@
|
|||
# Testing unstow_contents_orig()
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(.); require "t/util.pm"; require "stow"; }
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 20;
|
||||
use testutil;
|
||||
|
||||
use Test::More tests => 21;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
### setup
|
||||
eval { remove_dir('t/target'); };
|
||||
eval { remove_dir('t/stow'); };
|
||||
make_dir('t/target');
|
||||
make_dir('t/stow');
|
||||
|
||||
chdir 't/target';
|
||||
$Stow_Path= '../stow';
|
||||
make_fresh_stow_and_target_dirs();
|
||||
cd('t/target');
|
||||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
my $stow;
|
||||
my @conflicts;
|
||||
|
||||
#
|
||||
# unstow a simple tree minimally
|
||||
#
|
||||
|
||||
reset_state();
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_dir('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1','../stow/pkg1/bin1');
|
||||
make_link('bin1', '../stow/pkg1/bin1');
|
||||
|
||||
unstow_contents_orig('../stow/pkg1','.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg1');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-f '../stow/pkg1/bin1/file1' && ! -e 'bin1'
|
||||
=> 'unstow a simple tree'
|
||||
);
|
||||
|
|
@ -43,16 +42,16 @@ ok(
|
|||
#
|
||||
# unstow a simple tree from an existing directory
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_dir('lib2');
|
||||
make_dir('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
|
||||
unstow_contents_orig('../stow/pkg2','.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg2');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-f '../stow/pkg2/lib2/file2' && -d 'lib2'
|
||||
=> 'unstow simple tree from a pre-existing directory'
|
||||
);
|
||||
|
|
@ -60,7 +59,7 @@ ok(
|
|||
#
|
||||
# fold tree after unstowing
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_dir('bin3');
|
||||
|
||||
|
|
@ -71,10 +70,10 @@ make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
|
|||
make_dir('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
|
||||
unstow_contents_orig('../stow/pkg3b', '.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'bin3' &&
|
||||
readlink('bin3') eq '../stow/pkg3a/bin3'
|
||||
=> 'fold tree after unstowing'
|
||||
|
|
@ -83,17 +82,17 @@ ok(
|
|||
#
|
||||
# existing link is owned by stow but is invalid so it gets removed anyway
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_dir('bin4');
|
||||
make_dir('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
make_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
|
||||
|
||||
unstow_contents_orig('../stow/pkg4', '.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg4');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
! -e 'bin4/file4'
|
||||
=> q(remove invalid link owned by stow)
|
||||
);
|
||||
|
|
@ -101,12 +100,12 @@ ok(
|
|||
#
|
||||
# Existing link is not owned by stow
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_dir('../stow/pkg5/bin5');
|
||||
make_link('bin5', '../not-stow');
|
||||
|
||||
unstow_contents_orig('../stow/pkg5', '.');
|
||||
$stow->plan_unstow('pkg5');
|
||||
#like(
|
||||
# $Conflicts[-1], qr(CONFLICT:.*can't unlink.*not owned by stow)
|
||||
# => q(existing link not owned by stow)
|
||||
|
|
@ -115,10 +114,11 @@ ok(
|
|||
-l 'bin5' && readlink('bin5') eq '../not-stow'
|
||||
=> q(existing link not owned by stow)
|
||||
);
|
||||
|
||||
#
|
||||
# Target already exists, is owned by stow, but points to a different package
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_dir('bin6');
|
||||
make_dir('../stow/pkg6a/bin6');
|
||||
|
|
@ -128,9 +128,9 @@ make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
|
|||
make_dir('../stow/pkg6b/bin6');
|
||||
make_file('../stow/pkg6b/bin6/file6');
|
||||
|
||||
unstow_contents_orig('../stow/pkg6b', '.');
|
||||
$stow->plan_unstow('pkg6b');
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'bin6/file6' &&
|
||||
readlink('bin6/file6') eq '../../stow/pkg6a/bin6/file6'
|
||||
=> q(ignore existing link that points to a different package)
|
||||
|
|
@ -139,24 +139,22 @@ ok(
|
|||
#
|
||||
# Don't unlink anything under the stow directory
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('stow'); # make out stow dir a subdir of target
|
||||
$Stow_Path = 'stow';
|
||||
$stow = new_compat_Stow(dir => 'stow');
|
||||
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_dir('stow/pkg7a/stow/pkg7b');
|
||||
make_file('stow/pkg7a/stow/pkg7b/file7b');
|
||||
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
|
||||
|
||||
unstow_contents_orig('stow/pkg7b', '.');
|
||||
$stow->plan_unstow('pkg7b');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg7b'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'stow/pkg7b' &&
|
||||
readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
|
||||
=> q(don't unlink any nodes under the stow directory)
|
||||
|
|
@ -165,10 +163,7 @@ ok(
|
|||
#
|
||||
# Don't unlink any nodes under another stow directory
|
||||
#
|
||||
reset_state();
|
||||
|
||||
make_dir('stow'); # make out stow dir a subdir of target
|
||||
$Stow_Path = 'stow';
|
||||
$stow = new_compat_Stow(dir => 'stow');
|
||||
|
||||
make_dir('stow2'); # make our alternate stow dir a subdir of target
|
||||
make_file('stow2/.stow');
|
||||
|
|
@ -178,14 +173,14 @@ make_dir('stow/pkg8a/stow2/pkg8b');
|
|||
make_file('stow/pkg8a/stow2/pkg8b/file8b');
|
||||
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
|
||||
|
||||
unstow_contents_orig('stow/pkg8a', '.');
|
||||
$stow->plan_unstow('pkg8a');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg8a'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-l 'stow2/pkg8b' &&
|
||||
readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
|
||||
=> q(don't unlink any nodes under another stow directory)
|
||||
|
|
@ -194,10 +189,8 @@ ok(
|
|||
#
|
||||
# overriding already stowed documentation
|
||||
#
|
||||
reset_state();
|
||||
$stow = new_compat_Stow(override => ['man9', 'info9']);
|
||||
make_file('stow/.stow');
|
||||
$Stow_Path = '../stow';
|
||||
$Option{'override'} = ['man9', 'info9'];
|
||||
|
||||
make_dir('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
|
|
@ -206,10 +199,10 @@ make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emu
|
|||
|
||||
make_dir('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
unstow_contents_orig('../stow/pkg9b', '.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg9b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
!-l 'man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
|
|
@ -217,8 +210,7 @@ ok(
|
|||
#
|
||||
# deferring to already stowed documentation
|
||||
#
|
||||
reset_state();
|
||||
$Option{'defer'} = ['man10', 'info10'];
|
||||
$stow = new_compat_Stow(defer => ['man10', 'info10']);
|
||||
|
||||
make_dir('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10a.1');
|
||||
|
|
@ -233,14 +225,14 @@ make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1'
|
|||
|
||||
make_dir('../stow/pkg10c/man10/man1');
|
||||
make_file('../stow/pkg10c/man10/man1/file10a.1');
|
||||
unstow_contents_orig('../stow/pkg10c', '.');
|
||||
$stow->plan_unstow('pkg10c');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg10c'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
|
|
@ -248,8 +240,7 @@ ok(
|
|||
#
|
||||
# Ignore temp files
|
||||
#
|
||||
reset_state();
|
||||
$Option{'ignore'} = ['~', '\.#.*'];
|
||||
$stow = new_compat_Stow(ignore => ['~', '\.#.*']);
|
||||
|
||||
make_dir('../stow/pkg12/man12/man1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1');
|
||||
|
|
@ -258,10 +249,10 @@ make_file('../stow/pkg12/man12/man1/.#file12.1');
|
|||
make_dir('man12/man1');
|
||||
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
|
||||
|
||||
unstow_contents_orig('../stow/pkg12', '.');
|
||||
process_tasks();
|
||||
$stow->plan_unstow('pkg12');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar(@Conflicts) == 0 &&
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
!-e 'man12/man1/file12.1'
|
||||
=> 'ignore temp files'
|
||||
);
|
||||
|
|
@ -269,15 +260,15 @@ ok(
|
|||
#
|
||||
# Unstow an already unstowed package
|
||||
#
|
||||
reset_state();
|
||||
unstow_contents_orig('../stow/pkg12', '.');
|
||||
$stow = new_compat_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg12'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0
|
||||
scalar($stow->get_conflicts) == 0
|
||||
=> 'unstow already unstowed package pkg12'
|
||||
);
|
||||
|
||||
|
|
@ -288,15 +279,15 @@ ok(
|
|||
eval { remove_dir('t/target'); };
|
||||
mkdir('t/target');
|
||||
|
||||
reset_state();
|
||||
unstow_contents_orig('../stow/pkg12', '.');
|
||||
$stow = new_compat_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg12 which was never stowed'
|
||||
);
|
||||
ok(
|
||||
scalar(@Conflicts) == 0
|
||||
scalar($stow->get_conflicts) == 0
|
||||
=> 'unstow never stowed package pkg12'
|
||||
);
|
||||
|
||||
|
|
@ -305,19 +296,38 @@ ok(
|
|||
#
|
||||
make_file('man12/man1/file12.1');
|
||||
|
||||
reset_state();
|
||||
unstow_contents('../stow/pkg12', '.');
|
||||
$stow = new_compat_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
stderr_like(
|
||||
sub { process_tasks(); },
|
||||
sub { $stow->process_tasks(); },
|
||||
qr/There are no outstanding operations to perform/,
|
||||
'no tasks to process when unstowing pkg12 for third time'
|
||||
);
|
||||
@conflicts = $stow->get_conflicts;
|
||||
ok(
|
||||
scalar(@Conflicts) == 1 &&
|
||||
$Conflicts[0] =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
|
||||
@conflicts == 1 &&
|
||||
$conflicts[0] =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
|
||||
=> 'unstow pkg12 for third time'
|
||||
);
|
||||
|
||||
#
|
||||
# unstow a simple tree minimally when cwd isn't target
|
||||
#
|
||||
cd('../..');
|
||||
$stow = new_Stow(dir => 't/stow', target => 't/target');
|
||||
|
||||
make_dir('t/stow/pkg13/bin13');
|
||||
make_file('t/stow/pkg13/bin13/file13');
|
||||
make_link('t/target/bin13', '../stow/pkg13/bin13');
|
||||
|
||||
$stow->plan_unstow('pkg13');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
scalar($stow->get_conflicts) == 0 &&
|
||||
-f 't/stow/pkg13/bin13/file13' && ! -e 't/target/bin13'
|
||||
=> 'unstow a simple tree'
|
||||
);
|
||||
|
||||
|
||||
# Todo
|
||||
#
|
||||
|
|
|
|||
Loading…
Reference in a new issue