Raise the global lock timeouts

[dbsrgits/DBIx-Class.git] / t / lib / DBICTest / Util.pm

diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm
index 990050c..3e250cc 100644 (file)
--- a/t/lib/DBICTest/Util.pm
+++ b/t/lib/DBICTest/Util.pm
@@ -5,7 +5,11 @@ use strict;
 
 use ANFANG;
 
-use DBICTest::RunMode;
+use Config;
+use Carp qw(cluck confess croak);
+use Fcntl qw( :DEFAULT :flock );
+use Scalar::Util qw( blessed refaddr openhandle );
+use DBIx::Class::_Util qw( scope_guard parent_dir );
 
 use constant {
 
@@ -19,25 +23,25 @@ use constant {
   # add an escape for these perls ON SMOKERS - a user/CI will still get death
   # constname a homage to http://theoatmeal.com/comics/working_home
   PEEPEENESS => (
+    (
+      DBIx::Class::_ENV_::PERL_VERSION >= 5.013005
+        and
+      DBIx::Class::_ENV_::PERL_VERSION <= 5.013006
+    )
+      and
+    require DBICTest::RunMode
+      and
     DBICTest::RunMode->is_smoker
       and
     ! DBICTest::RunMode->is_ci
-      and
-    ( "$]" >= 5.013005 and "$]" <= 5.013006)
   ),
 };
 
-use Config;
-use Carp qw(cluck confess croak);
-use Fcntl qw( :DEFAULT :flock );
-use Scalar::Util qw( blessed refaddr openhandle );
-use DBIx::Class::_Util qw( scope_guard parent_dir );
-
 use base 'Exporter';
 our @EXPORT_OK = qw(
   dbg stacktrace class_seems_loaded
   local_umask slurp_bytes tmpdir find_co_root rm_rf
-  visit_namespaces PEEPEENESS
+  PEEPEENESS
   check_customcond_args
   await_flock DEBUG_TEST_CONCURRENCY_LOCKS
 );
@@ -72,7 +76,7 @@ sub dbg ($) {
 # This figure esentially means "how long can a single test hold a
 # resource before everyone else gives up waiting and aborts" or
 # in other words "how long does the longest test-group legitimally run?"
-my $lock_timeout_minutes = 15;  # yes, that's long, I know
+my $lock_timeout_minutes = 30;  # yes, that's long, I know
 my $wait_step_seconds = 0.25;
 
 sub await_flock ($$) {
@@ -105,6 +109,9 @@ sub await_flock ($$) {
     }
   }
 
+  print STDERR "Lock timeout of $lock_timeout_minutes minutes reached: "
+    unless $res;
+
   return $res;
 }
 
@@ -278,7 +285,7 @@ sub slurp_bytes ($) {
 
 
 sub rm_rf ($) {
-  croak "No valid argument supplied to rm_rf()" unless length "$_[0]";
+  croak "No argument supplied to rm_rf()" unless length "$_[0]";
 
   return unless -e $_[0];
 
@@ -409,36 +416,6 @@ sub check_customcond_args ($) {
   $args;
 }
 
-sub visit_namespaces {
-  my $args = { (ref $_[0]) ? %{$_[0]} : @_ };
-
-  my $visited_count = 1;
-
-  # A package and a namespace are subtly different things
-  $args->{package} ||= 'main';
-  $args->{package} = 'main' if $args->{package} =~ /^ :: (?: main )? $/x;
-  $args->{package} =~ s/^:://;
-
-  if ( $args->{action}->($args->{package}) ) {
-    my $ns =
-      ( ($args->{package} eq 'main') ? '' :  $args->{package} )
-        .
-      '::'
-    ;
-
-    $visited_count += visit_namespaces( %$args, package => $_ ) for
-      grep
-        # this happens sometimes on %:: traversal
-        { $_ ne '::main' }
-        map
-          { $_ =~ /^(.+?)::$/ ? "$ns$1" : () }
-          do { no strict 'refs'; keys %$ns }
-    ;
-  }
-
-  return $visited_count;
-}
-
 #
 # Replicate the *heuristic* (important!!!) implementation found in various
 # forms within Class::Load / Module::Inspector / Class::C3::Componentised