X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FRunMode.pm;h=fb3680587c09f759bbaf471e8d8cb12cd9a6deb3;hb=6853e2c32de07a3cec73855597ccc8b863cd4d54;hp=348c8ea757119a83d7028aa423e25c19adb8dd6d;hpb=fa19e5d684ce8181f2fa2e0cd79bed14de889650;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/lib/DBICTest/RunMode.pm b/t/lib/DBICTest/RunMode.pm
index 348c8ea..fb36805 100644
--- a/t/lib/DBICTest/RunMode.pm
+++ b/t/lib/DBICTest/RunMode.pm
@@ -13,12 +13,25 @@ BEGIN {
 
     die __PACKAGE__ . " must be loaded before DBIx::Class (or modules using DBIx::Class) at $frame[1] line $frame[2]\n";
   }
+
+  if ( $ENV{DBICTEST_VERSION_WARNS_INDISCRIMINATELY} ) {
+    my $ov = UNIVERSAL->can("VERSION");
+
+    require Carp;
+
+    no warnings 'redefine';
+    *UNIVERSAL::VERSION = sub {
+      Carp::carp( 'Argument "blah bleh bloh" isn\'t numeric in subroutine entry' );
+      &$ov;
+    };
+  }
 }
 
 use Path::Class qw/file dir/;
 use Fcntl ':DEFAULT';
 use File::Spec ();
 use File::Temp ();
+use DBICTest::Util 'local_umask';
 
 _check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
 
@@ -43,26 +56,28 @@ sub tmpdir {
     else {
       # make sure we can actually create and sysopen a file in this dir
       local $@;
-      my $tfh;
+      my $u = local_umask(0); # match the umask we use in DBICTest(::Schema)
+      my $tempfile = '<NONCREATABLE>';
       eval {
-        $tfh = File::Temp->new(
-          TEMPLATE => '_dbictest_writability_XXXXXX',
+        $tempfile = File::Temp->new(
+          TEMPLATE => '_dbictest_writability_test_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";
+        close $tempfile or die "closing $tempfile failed: $!\n";
+
+        sysopen (my $tempfh2, "$tempfile", O_RDWR) or die "reopening $tempfile failed: $!\n";
+        print $tempfh2 'deadbeef' x 1024 or die "printing to $tempfile failed: $!\n";
+        close $tempfh2 or die "closing $tempfile 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;
+        my @x_tests = map { (defined $_) ? ( $_ ? 1 : 0 ) : 'U' } map {(-e, -d, -f, -r, -w, -x, -o)} ("$dir", "$tempfile");
+        $reason_dir_unusable = sprintf <<"EOE", "$tempfile"||'', $err, scalar $>, scalar $), umask(), (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
+Effective umask:   %o
 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
@@ -194,15 +209,31 @@ sub is_author {
 }
 
 sub is_smoker {
-  return
-    ( ($ENV{TRAVIS}||'') eq 'true' )
-      ||
+  return (
     ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
-  ;
+      or
+    __PACKAGE__->is_ci
+  );
+}
+
+sub is_ci {
+  return (
+    ($ENV{TRAVIS}||'') eq 'true'
+      and
+    ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
+  )
 }
 
 sub is_plain {
-  return (! __PACKAGE__->is_smoker && ! __PACKAGE__->is_author && ! $ENV{RELEASE_TESTING} )
+  return (
+    ! $ENV{RELEASE_TESTING}
+      and
+    ! $ENV{DBICTEST_RUN_ALL_TESTS}
+      and
+    ! __PACKAGE__->is_smoker
+      and
+    ! __PACKAGE__->is_author
+  )
 }
 
 # Try to determine the root of a checkout/untar if possible