X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F00describe_environment.t;h=ed0378bb80d59816825d366f086bc5bcb912df36;hb=02154caf0cf887228849fd0d88e0d6636ef21f8c;hp=82f2fdb27c2ae09d7975777c2ac0b0fb75d74037;hpb=83361151a7b2378ce3b7926a69f36d28fd937cb1;p=dbsrgits%2FDBIx-Class.git diff --git a/t/00describe_environment.t b/t/00describe_environment.t index 82f2fdb..ed0378b 100644 --- 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 ... 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]