Have tests recover gracefully when File::Spec->tmpdir gives us lemons

Once and for all solves http://www.cpantesters.org/cpan/report/36d4436d-7888-1014-a278-e5322b825c07
Perl5 · Jan 23, 2014 · fa19e5d · fa19e5d
1 parent bf30289
commit fa19e5d
Show file tree

Hide file tree

Showing 3 changed files with 51 additions and 20 deletions.
diff --git a/Changes b/Changes
@@ -47,6 +47,7 @@ Revision history for DBIx::Class
           the design for proper documentation and opening up)
         - Adjust exceptions in tests to accommodate changes in the upcoming
           DBD::SQLite based on libsqlite 3.8.2
+        - Better diagnostics when File::Spec->tmpdir gives us crap in testing
         - Replace $row with $result in all docs to be consistent and to
           clarify various return values
 

diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
@@ -101,20 +101,8 @@ sub import {
 
     {
       my $u = local_umask(0); # so that the file opens as 666, and any user can lock
-      sysopen ($global_lock_fh, $lockpath, O_RDWR|O_CREAT) or do {
-        my $err = $!;
-
-        my @x_tests = map { (defined $_) ? ( $_ ? 1 : 0 ) : 'U' } map {(-e, -d, -f, -r, -w, -x, -o)} ($tmpdir, $lockpath);
-
-        die sprintf <<"EOE", $lockpath, $err, scalar $>, scalar $), (stat($tmpdir))[4,5,2], @x_tests;
-Unable to open %s: %s
-Process EUID/EGID: %s / %s
-TmpDir UID/GID:    %s / %s
-TmpDir StatMode:   %o
-TmpDir X-tests:    -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
-TmpFile X-tests:   -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
-EOE
-      };
+      sysopen ($global_lock_fh, $lockpath, O_RDWR|O_CREAT)
+        or die "Unable to open $lockpath: $!";
     }
 
     for (@_) {

diff --git a/t/lib/DBICTest/RunMode.pm b/t/lib/DBICTest/RunMode.pm
@@ -16,7 +16,9 @@ BEGIN {
 }
 
 use Path::Class qw/file dir/;
-use File::Spec;
+use Fcntl ':DEFAULT';
+use File::Spec ();
+use File::Temp ();
 
 _check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
 
@@ -28,16 +30,56 @@ my $tmpdir;
 sub tmpdir {
   dir ($tmpdir ||= do {
 
+    # works but not always
     my $dir = dir(File::Spec->tmpdir);
+    my $reason_dir_unusable;
 
     my @parts = File::Spec->splitdir($dir);
-    if (@parts == 2 and $parts[1] eq '') {
-      # This means we were give the root dir (C:\ or something equally unacceptable)
+    if (@parts == 2 and $parts[1] =~ /^ [ \\ \/ ]? $/x ) {
+      $reason_dir_unusable =
+        'File::Spec->tmpdir returned a root directory instead of a designated '
+      . 'tempdir (possibly https://rt.cpan.org/Ticket/Display.html?id=76663)';
+    }
+    else {
+      # make sure we can actually create and sysopen a file in this dir
+      local $@;
+      my $tfh;
+      eval {
+        $tfh = File::Temp->new(
+          TEMPLATE => '_dbictest_writability_XXXXXX',
+          DIR => "$dir",
+          UNLINK => 1,
+        );
+        my $fn = "$tfh";
+        close $tfh or die "closing $fn failed: $!\n";
+        sysopen (my $tfh2, $fn, O_RDWR) or die "reopening $fn failed: $!\n";
+        print $tfh2 'deadbeef' x 1024 or die "printing to $fn failed: $!\n";
+        close $tfh2 or die "closing $fn failed: $!\n";
+        1;
+      } or do {
+        chomp( my $err = $@ );
+        my @x_tests = map { (defined $_) ? ( $_ ? 1 : 0 ) : 'U' } map {(-e, -d, -f, -r, -w, -x, -o)} ("$dir", "$tfh");
+        $reason_dir_unusable = sprintf <<"EOE", "$tfh"||'', $err, scalar $>, scalar $), (stat($dir))[4,5,2], @x_tests;
+File::Spec->tmpdir returned a directory which appears to be non-writeable:
+Error encountered while testing '%s': %s
+Process EUID/EGID: %s / %s
+TmpDir UID/GID:    %s / %s
+TmpDir StatMode:   %o
+TmpDir X-tests:    -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
+TmpFile X-tests:   -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
+EOE
+      };
+    }
+
+    if ($reason_dir_unusable) {
       # Replace with our local project tmpdir. This will make multiple runs
       # from different runs conflict with each other, but is much better than
-      # polluting the root dir with random crap
-      $dir = _find_co_root()->subdir('t')->subdir('var');
-      $dir->mkpath;
+      # polluting the root dir with random crap or failing outright
+      my $local_dir = _find_co_root()->subdir('t')->subdir('var');
+      $local_dir->mkpath;
+
+      warn "\n\nUsing '$local_dir' as test scratch-dir instead of '$dir': $reason_dir_unusable\n";
+      $dir = $local_dir;
     }
 
     $dir->stringify;