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 {
# 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 mkdir_p );
-
use base 'Exporter';
our @EXPORT_OK = qw(
- dbg stacktrace
+ 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
);
# 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 ($$) {
# prove -lj10 xt/extra/internals/
#
select( ( select(\*STDOUT), $|=1 )[0] );
-
- print "#\n";
+ print STDOUT "#\n";
}
}
+ print STDERR "Lock timeout of $lock_timeout_minutes minutes reached: "
+ unless $res;
+
return $res;
}
croak "Setting umask failed: $!" unless defined $old_umask;
scope_guard(sub {
- local ($@, $!, $?);
+ local ( $!, $^E, $?, $@ );
eval {
defined(umask $old_umask) or die "nope";
# polluting the root dir with random crap or failing outright
my $local_dir = find_co_root . 't/var/';
- mkdir_p $local_dir;
+ # Generlly this should be handled by ANFANG, but double-check ourselves
+ # Not using mkdir_p here: we *know* everything else up until 'var' exists
+ # If it doesn't - we better fail outright
+ # (also saves an extra File::Path require(), small enough as it is)
+ -d $local_dir
+ or
+ mkdir $local_dir
+ or
+ die "Unable to create build-local tempdir '$local_dir': $!\n";
warn "\n\nUsing '$local_dir' as test scratch-dir instead of '$dir': $reason_dir_unusable\n\n";
$dir = $local_dir;
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];
$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 }
- ;
- }
+#
+# Replicate the *heuristic* (important!!!) implementation found in various
+# forms within Class::Load / Module::Inspector / Class::C3::Componentised
+#
+sub class_seems_loaded ($) {
+
+ croak "Function expects a class name as plain string (no references)"
+ unless defined $_[0] and not length ref $_[0];
+
+ no strict 'refs';
+
+ return 1 if defined ${"$_[0]::VERSION"};
+
+ return 1 if @{"$_[0]::ISA"};
+
+ return 1 if $INC{ (join ('/', split ('::', $_[0]) ) ) . '.pm' };
+
+ ( !!*{"$_[0]::$_"}{CODE} ) and return 1
+ for keys %{"$_[0]::"};
- return $visited_count;
+ return 0;
}
1;