Ensure describe_environment does not break its output in half

[dbsrgits/DBIx-Class.git] / t / 00describe_environment.t

diff --git a/t/00describe_environment.t b/t/00describe_environment.t
index 82f2fdb..ed0378b 100644 (file)
--- a/t/00describe_environment.t
+++ b/t/00describe_environment.t
@@ -11,10 +11,10 @@ BEGIN {
   @initial_INC = @INC;
 }
 
-BEGIN {
-  unshift @INC, 't/lib';
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
 
-  if ($] < 5.010) {
+BEGIN {
+  if ( "$]" < 5.010) {
 
     # Pre-5.10 perls pollute %INC on unsuccesfull module
     # require, making it appear as if the module is already
@@ -57,7 +57,7 @@ use List::Util 'max';
 use ExtUtils::MakeMaker;
 
 use DBICTest::RunMode;
-use DBICTest::Util 'visit_namespaces';
+use DBIx::Class::_Util 'visit_namespaces';
 use DBIx::Class::Optional::Dependencies;
 
 my $known_paths = {
@@ -118,6 +118,10 @@ my $known_paths = {
     rel_path => './t',
     skip_unversioned_modules => 1,
   },
+  XT => {
+    rel_path => './xt',
+    skip_unversioned_modules => 1,
+  },
   CWD => {
     rel_path => '.',
   },
@@ -163,6 +167,8 @@ find({
   wanted => sub {
     -f $_ or return;
 
+    $_ =~ m|lib/DBIx/Class/_TempExtlib| and return;
+
     # can't just `require $fn`, as we need %INC to be
     # populated properly
     my ($mod) = $_ =~ /^ lib [\/\\] (.+) \.pm $/x
@@ -188,6 +194,7 @@ my $load_weights = {
 
 my @known_modules = sort
   { ($load_weights->{$b}||0) <=> ($load_weights->{$a}||0) }
+  qw( Data::Dumper ),
   keys %{
     DBIx::Class::Optional::Dependencies->req_list_for([
       grep
@@ -240,12 +247,12 @@ my $interesting_modules = {
   # pseudo module
   $perl => {
     version => $],
-    abs_unix_path => $^X,
+    abs_unix_path => abs_unix_path($^X),
   }
 };
 
 
-# drill through the *ENTIRE* symtable and build a map of intereseting modules
+# drill through the *ENTIRE* symtable and build a map of interesting modules
 visit_namespaces( action => sub {
   no strict 'refs';
   my $pkg = shift;
@@ -339,7 +346,8 @@ visit_namespaces( action => sub {
       $interesting_modules->{$pkg}{version} = $mod_ver;
     }
   }
-  elsif ( $abs_unix_path = $known_failed_loads->{$pkg} ) {
+  elsif ( $known_failed_loads->{$pkg} ) {
+    $abs_unix_path = $known_failed_loads->{$pkg};
     $interesting_modules->{$pkg}{version} = '!! LOAD FAIL !!';
   }
 
@@ -386,8 +394,8 @@ visit_namespaces( action => sub {
   1;
 });
 
-# compress identical versions sourced from ./blib, ./lib and ./t as close to the root
-# of a namespace as we can
+# compress identical versions sourced from ./blib, ./lib, ./t and ./xt
+# as close to the root of a namespace as we can
 purge_identically_versioned_submodules_with_markers([ map {
   ( $_->{skip_unversioned_modules} && $_->{marker} ) || ()
 } values %$known_paths ]);
@@ -407,8 +415,8 @@ my $max_marker_len = max map { length $_ } ( '$INC[999]', keys %$seen_markers );
 
 my $discl = <<'EOD';
 
-List of loadable modules within both the core and *OPTIONAL* dependency
-chains present on this system (modules sourced from ./blib, ./lib and ./t
+List of loadable modules within both the core and *OPTIONAL* dependency chains
+present on this system (modules sourced from ./blib, ./lib, ./t, and ./xt
 with versions identical to their parent namespace were omitted for brevity)
 
     *** Note that *MANY* of these modules will *NEVER* be loaded ***
@@ -424,9 +432,9 @@ $final_out .= "\@INC at startup (does not reflect manipulation at runtime):\n";
 my $in_inc_skip;
 for (0.. $#initial_INC) {
 
-  my $path = shorten_fn( $initial_INC[$_] );
+  my $shortname = shorten_fn( $initial_INC[$_] );
 
-  # when *to* print
+  # when *to* print a line of INC
   if (
     ! $ENV{AUTOMATED_TESTING}
       or
@@ -434,14 +442,14 @@ for (0.. $#initial_INC) {
       or
     $seen_markers->{"\$INC[$_]"}
       or
-    ! -e $path
+    ! -e $shortname
       or
-    ! File::Spec->file_name_is_absolute($path)
+    ! File::Spec->file_name_is_absolute($shortname)
   ) {
     $in_inc_skip = 0;
     $final_out .= sprintf ( "% 3s: %s\n",
       $_,
-      $path
+      $shortname
     );
   }
   elsif(! $in_inc_skip++) {
@@ -493,6 +501,11 @@ $final_out .= "=============================\n$discl\n\n";
 
 diag $final_out;
 
+# *very* large printouts may not finish flushing before the test exits
+# injecting a <testname> ... ok in the middle of the diag
+# http://www.cpantesters.org/cpan/report/fbdac74c-35ca-11e6-ab41-c893a58a4b8c
+select( undef, undef, undef, 0.2 );
+
 exit 0;
 
 
@@ -554,10 +567,14 @@ sub shorten_fn {
 
   # we got so far - not a known path
   # return the unixified version it if was absolute, leave as-is otherwise
-  return ( $abs_fn and File::Spec->file_name_is_absolute( $fn ) )
+  my $rv = ( $abs_fn and File::Spec->file_name_is_absolute( $fn ) )
     ? $abs_fn
     : $fn
   ;
+
+  $rv = "( ! -e ) $rv" unless -e $rv;
+
+  return $rv;
 }
 
 sub subpath_of_known_path {
@@ -588,12 +605,21 @@ sub module_found_at_inc_index {
 
   my $fn = module_notional_filename($mod);
 
-  for my $i ( 0 .. $#$inc_dirs ) {
+  # trust INC if it specifies an existing path
+  if( -f ( my $existing_path = abs_unix_path( $INC{$fn} ) ) ) {
+    for my $i ( 0 .. $#$inc_dirs ) {
 
-    # searching from here on out won't mean anything
-    # FIXME - there is actually a way to interrogate this safely, but
-    # that's a fight for another day
-    return undef if length ref $inc_dirs->[$i];
+      # searching from here on out won't mean anything
+      # FIXME - there is actually a way to interrogate this safely, but
+      # that's a fight for another day
+      return undef if length ref $inc_dirs->[$i];
+
+      return $i
+        if 0 == index( $existing_path, abs_unix_path( $inc_dirs->[$i] ) . '/' );
+    }
+  }
+
+  for my $i ( 0 .. $#$inc_dirs ) {
 
     if (
       -d $inc_dirs->[$i]