X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FUtil.pm;h=990050cb0306c81f533a6c539e1f0c077baba456;hb=17afd4efaada78208fcb697599292a284a825cdb;hp=68b6e2c68ff31a8c93bc20a9dfb09e2c0361fb4e;hpb=24fbd7fba01adfc25b53614f8d713af1bd31ae21;p=dbsrgits%2FDBIx-Class.git diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm index 68b6e2c..990050c 100644 --- a/t/lib/DBICTest/Util.pm +++ b/t/lib/DBICTest/Util.pm @@ -31,11 +31,11 @@ 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 DBIx::Class::_Util qw( scope_guard parent_dir ); 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 check_customcond_args @@ -88,7 +88,21 @@ sub await_flock ($$) { # "say something" every 10 cycles to work around RT#108390 # jesus christ our tooling is such a crock of shit :( - print "#\n" if not $tries % 10; + unless ( $tries % 10 ) { + + # Turning on autoflush is crucial: if stars align just right buffering + # will ensure we never actually call write() underneath until the grand + # timeout is reached (and that's too long). Reproducible via + # + # DBICTEST_VERSION_WARNS_INDISCRIMINATELY=1 \ + # DBICTEST_RUN_ALL_TESTS=1 \ + # strace -f \ + # prove -lj10 xt/extra/internals/ + # + select( ( select(\*STDOUT), $|=1 )[0] ); + + print "#\n"; + } } return $res; @@ -235,7 +249,15 @@ EOE # 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; @@ -417,4 +439,27 @@ sub visit_namespaces { return $visited_count; } +# +# 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 0; +} + 1;