Use make_invalid_link() to reliably setup symlink fixtures.

NEWS

@@ -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.

t/chkstow.t

@@ -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,

t/cleanup_invalid_links.t

@@ -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');

t/stow.t

@@ -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');
 

t/testutil.pm

@@ -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 {
-        symlink $source, $target
-            or die "could not create link $target => $source ($!)\n";
+        croak "Won't make link pointing to non-existent $abs_target"
+            unless $invalid;
     }
-    return;
+    symlink $source, $target
+        or die "could not create link $target => $source ($!)\n";
+}
+
+#===== 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 ===========================================================

t/unstow.t

@@ -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;

t/unstow_orig.t

@@ -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