Use make_invalid_link() to reliably setup symlink fixtures.

This commit is contained in:
Adam Spiers 2012-02-18 20:19:05 +00:00
parent af4557c543
commit 91c816e32d
7 changed files with 46 additions and 17 deletions

4
NEWS
View file

@ -2,6 +2,10 @@ News file for Stow.
* Changes in version 2.1.4
** Test suite improvements
The test suite has been tightened up slightly.
** Documentation improvements
Various fixes and cosmetic improvements have been made in the manual.

View file

@ -98,7 +98,7 @@ stdout_like(
qr{Unstowed\ file:\ ./bin/alien}xms,
"Aliens exist");
make_link('bin/link', 'ireallyhopethisfiledoesn/t.exist');
make_invalid_link('bin/link', 'ireallyhopethisfiledoesn/t.exist');
@ARGV = ('-t', '.', '-b');
stdout_like(
\&run_chkstow,

View file

@ -42,7 +42,7 @@ 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');
make_invalid_link('bin2/file2b', '../../stow/pkg2/bin2/file2b');
$stow = new_Stow();
$stow->cleanup_invalid_links('bin2');
@ -58,7 +58,7 @@ make_dir('bin3');
make_dir('../stow/pkg3/bin3');
make_file('../stow/pkg3/bin3/file3a');
make_link('bin3/file3a', '../../stow/pkg3/bin3/file3a');
make_link('bin3/file3b', '../../empty');
make_invalid_link('bin3/file3b', '../../empty');
$stow = new_Stow();
$stow->cleanup_invalid_links('bin3');

View file

@ -180,7 +180,7 @@ for my $file ('file4c', 'bin4c/file4c') {
$stow = new_Stow();
make_dir('bin5');
make_link('bin5/file5','../../empty');
make_invalid_link('bin5/file5','../../empty');
make_dir('../stow/pkg5/bin5/file5');
$stow->plan_stow('pkg5');
@ -196,7 +196,7 @@ like(
#
$stow = new_Stow();
make_link('file6','../stow/path-does-not-exist');
make_invalid_link('file6','../stow/path-does-not-exist');
make_dir('../stow/pkg6');
make_file('../stow/pkg6/file6');

View file

@ -9,7 +9,10 @@ package testutil;
use strict;
use warnings;
use Carp qw(croak);
use File::Basename;
use File::Path qw(remove_tree);
use File::Spec;
use Stow;
use Stow::Util qw(parent canon_path);
@ -20,7 +23,7 @@ our @EXPORT = qw(
init_test_dirs
cd
new_Stow new_compat_Stow
make_dir make_link make_file
make_dir make_link make_invalid_link make_file
remove_dir remove_link
cat_file
);
@ -56,28 +59,50 @@ sub new_compat_Stow {
# Purpose : safely create a link
# Parameters: $target => path to the link
# : $source => where the new link should point
# : $invalid => true iff $source refers to non-existent file
# Returns : n/a
# Throws : fatal error if the link can not be safely created
# Comments : checks for existing nodes
#============================================================================
sub make_link {
my ($target, $source) = @_;
my ($target, $source, $invalid) = @_;
if (-l $target) {
my $old_source = readlink join('/', parent($target), $source)
or die "could not read link $target/$source";
or die "$target is already a link but could not read link $target/$source";
if ($old_source ne $source) {
die "$target already exists but points elsewhere\n";
}
}
elsif (-e $target) {
die "$target already exists and is not a link\n";
die "$target already exists and is not a link\n" if -e $target;
my $abs_target = File::Spec->rel2abs($target);
my $target_container = dirname($abs_target);
my $abs_source = File::Spec->rel2abs($source, $target_container);
#warn "t $target c $target_container as $abs_source";
if (-e $abs_source) {
croak "Won't make invalid link pointing to existing $abs_target"
if $invalid;
}
else {
croak "Won't make link pointing to non-existent $abs_target"
unless $invalid;
}
symlink $source, $target
or die "could not create link $target => $source ($!)\n";
}
return;
#===== SUBROUTINE ===========================================================
# Name : make_invalid_link()
# Purpose : safely create an invalid link
# Parameters: $target => path to the link
# : $source => the non-existent source where the new link should point
# Returns : n/a
# Throws : fatal error if the link can not be safely created
# Comments : checks for existing nodes
#============================================================================
sub make_invalid_link {
my ($target, $source, $allow_invalid) = @_;
make_link($target, $source, 1);
}
#===== SUBROUTINE ===========================================================

View file

@ -87,7 +87,7 @@ $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');
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
$stow->plan_unstow('pkg4');
$stow->process_tasks();
@ -103,7 +103,7 @@ ok(
$stow = new_Stow();
make_dir('../stow/pkg5/bin5');
make_link('bin5', '../not-stow');
make_invalid_link('bin5', '../not-stow');
$stow->plan_unstow('pkg5');
%conflicts = $stow->get_conflicts;

View file

@ -88,7 +88,7 @@ $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');
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
$stow->plan_unstow('pkg4');
$stow->process_tasks();
@ -104,7 +104,7 @@ ok(
$stow = new_compat_Stow();
make_dir('../stow/pkg5/bin5');
make_link('bin5', '../not-stow');
make_invalid_link('bin5', '../not-stow');
$stow->plan_unstow('pkg5');
# Unlike the corresponding stow_contents.t test, this doesn't