From 392b07408ff3204ef448cbaf30e9ba65a91b2bc1 Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Wed, 5 Feb 2014 20:10:37 +0100 Subject: [PATCH 1/9] This no longer seems to be applicable --- lib/Test/DiagINC.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index d51c564..990dbd8 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -109,8 +109,7 @@ C was loaded will be excluded from the report (e.g. excludes local modules from C, C, and so on). The heuristic of searching C<%INC> for loaded modules may fail if the module -path loaded does not map to a package within the module file or if that package -does not define a C<$VERSION>. +path loaded does not map to a package within the module file. If C is loaded, the output will go via the C function. Otherwise, it will just be sent to STDERR. From 9262c4247b7b0d317f1ced76ff6beeee291dd5f6 Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Wed, 5 Feb 2014 19:13:15 +0100 Subject: [PATCH 2/9] Make sure we only report stuff the test loaded, no additions from ourselves What exactly was loaded is an important part of the diagnostic. Make sure that we only report on things that was loaded before us --- Changes | 3 ++ examples/fails.t | 1 + lib/Test/DiagINC.pm | 45 ++++++++++++++++++++++------- t/basic.t | 3 +- t/leanload.t | 70 +++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 111 insertions(+), 11 deletions(-) create mode 100644 t/leanload.t diff --git a/Changes b/Changes index d6ca2cb..7a90947 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,9 @@ Revision history for Test-DiagINC {{$NEXT}} + - Minimize amount of reported modules: anything Test::DiagINC loads + in order to compile the report is excluded + 0.002 2014-02-04 22:17:58-05:00 America/New_York [CHANGED] diff --git a/examples/fails.t b/examples/fails.t index d98a26e..948810e 100644 --- a/examples/fails.t +++ b/examples/fails.t @@ -2,6 +2,7 @@ use strict; use warnings; use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use Test::More tests => 1; +use ExtUtils::MakeMaker (); use lib 'examples/lib'; use Foo; diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index 990dbd8..247e2b8 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -1,12 +1,16 @@ use 5.008001; -use strict; -use warnings; package Test::DiagINC; # ABSTRACT: List modules and versions loaded if tests fail # VERSION -use Path::Tiny; +# If the tested module did not load strict/warnings we do not want +# to load them either. On the other hand we would like to know our +# code is at least somewhat ok. Therefore this madness ;) +BEGIN { if($ENV{RELEASE_TESTING}) { + require warnings && warnings->import; + require strict && strict->import; +} } sub _max_length { my $max = 0; @@ -15,15 +19,25 @@ sub _max_length { return $max; } +# Get our CWD *without* loading anything. Original idea by xdg++ +# ribasushi thinks this is fragile and will break sooner rather than +# later, but adding it as is because haarg and xdg both claim it's fine +my $REALPATH_CWD = `$^X -MCwd -e print+getcwd`; my $ORIGINAL_PID = $$; -my $CWD = path(".")->absolute; END { # Dump %INC if in the main process and have a non-zero exit code if ( $$ == $ORIGINAL_PID && $? ) { + + # make sure we report only on stuff that was loaded by the test, nothing more + my @INC_list = keys %INC; + + require Path::Tiny; + my $CWD = Path::Tiny::path($REALPATH_CWD); + chdir $CWD; # improve resolution of relative path names my @packages; - for my $p ( sort keys %INC ) { + for my $p ( sort @INC_list ) { next unless defined( $INC{$p} ) && !$CWD->subsumes( $INC{$p} ); next unless $p =~ s/\.pm\z//; $p =~ s{[\\/]}{::}g; @@ -88,10 +102,10 @@ For example: # 5.68 Exporter # 5.68 Exporter::Heavy # 1.07 PerlIO - # 1.001002 Test::Builder - # 1.001002 Test::Builder::Module - # 0.001 Test::DiagINC - # 1.001002 Test::More + # 0.98 Test::Builder + # 0.98 Test::Builder::Module + # 0.003 Test::DiagINC + # 0.98 Test::More # 1.22 overload # 0.02 overloading # 1.07 strict @@ -99,6 +113,16 @@ For example: # 1.18 warnings # 1.02 warnings::register +This module deliberately does not load B during runtime, +instead delaying all loads until it needs to generate a failure report in its +C block. The only exception is loading L and L for +self-check B C is true. Therefore an empty +invocation will look like this: + + $ perl -MTest::DiagINC -e 'exit(1)' + # Listing modules from %INC + # 0.003 Test::DiagINC + B: Because this module uses an C block, it must be loaded B C so that the C's C block has a chance to set the exit code first. If you're not using C, then it's up to you to @@ -106,7 +130,7 @@ ensure your code generates the non-zero exit code (e.g. C or C). Modules that appear to be sourced from below the current directory when C was loaded will be excluded from the report (e.g. excludes -local modules from C, C, and so on). +local modules from C<./>, C, C, and so on). The heuristic of searching C<%INC> for loaded modules may fail if the module path loaded does not map to a package within the module file. @@ -114,6 +138,7 @@ path loaded does not map to a package within the module file. If C is loaded, the output will go via the C function. Otherwise, it will just be sent to STDERR. + =cut # vim: ts=4 sts=4 sw=4 et: diff --git a/t/basic.t b/t/basic.t index a78a539..353cd5b 100644 --- a/t/basic.t +++ b/t/basic.t @@ -9,8 +9,9 @@ for my $file (qw/fails.t dies.t/) { my ( $stdout, $stderr ) = capture { system( $^X, "examples/$file" ); }; + like( $stderr, qr/\QListing modules from %INC/, "$file: Saw diagnostic header" ); - like( $stderr, qr/[0-9.]+\s+Path::Tiny/, "$file: Saw Path::Tiny in module list" ); + like( $stderr, qr/[0-9.]+\s+ExtUtils::MakeMaker/, "$file: Saw EUMM in module list" ); unlike( $stderr, qr/Foo/, "$file: Did not see local module Foo in module list", ); } diff --git a/t/leanload.t b/t/leanload.t new file mode 100644 index 0000000..9cc2c9e --- /dev/null +++ b/t/leanload.t @@ -0,0 +1,70 @@ +# +# WE ARE DOING %INC EXAMS IN THIS TEST +# No Test::More loaded, all TAP output by hand +# + +BEGIN { + if (keys %INC) { + print "1..0 # SKIP Your %INC is already populated, perhaps PERL5OPTS is set?\n"; + exit 0; + } +} + +# madness explanation at the top of Test::DiagInc +BEGIN { + if ($ENV{RELEASE_TESTING}) { + require warnings && warnings->import; + require strict && strict->import; + } + + @::initial_INC = keys %INC +} + +my $nongreat_success; +END { + cmp_inc_contents( @::initial_INC, 'Test/DiagINC.pm' ); + print "1..4\n"; + $? ||= ( $nongreat_success || 0 ); +} + +sub cmp_inc_contents { + my %current_inc = %INC; + + my @leftover_keys; + for (@_) { + if (exists $current_inc{$_}) { + delete $current_inc{$_} + } + else { + push @leftover_keys, $_ + } + } + + my $fail = 0; + if (my @mods = sort keys %current_inc) { + $_ =~ s|/|::|g for @mods; + $_ =~ s|\.pm$|| for @mods; + print "not ok - the following modules were unexpectedly found in %INC: @mods\n"; + $fail++; + } + else { + print "ok - %INC does not contain anything extra\n"; + } + + if (@leftover_keys) { + $_ =~ s|/|::|g for @leftover_keys; + $_ =~ s|\.pm$|| for @leftover_keys; + print "not ok - the following modules were expected but not found in %INC: @leftover_keys\n"; + $fail++; + } + else { + print "ok - %INC contents as expected\n"; + } + + $nongreat_success += $fail; +} + + +use Test::DiagINC; + +BEGIN { cmp_inc_contents( @::initial_INC, 'Test/DiagINC.pm' ) } From 1090fe59090d12a258fb6444853d34867b5f97b4 Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Thu, 6 Feb 2014 11:12:23 +0100 Subject: [PATCH 3/9] Rearrange skip logic to fire subsumes() last (no func. changes) Regexing is much cheaper --- lib/Test/DiagINC.pm | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index 247e2b8..470fdc4 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -37,11 +37,14 @@ END { chdir $CWD; # improve resolution of relative path names my @packages; - for my $p ( sort @INC_list ) { - next unless defined( $INC{$p} ) && !$CWD->subsumes( $INC{$p} ); - next unless $p =~ s/\.pm\z//; - $p =~ s{[\\/]}{::}g; - push @packages, $p if $p =~ /\A[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*\Z/; + for my $pkg_as_path ( sort @INC_list ) { + next unless defined $INC{$pkg_as_path}; + next unless (my $p = $pkg_as_path) =~ s/\.pm\z//; + $p =~ s{/}{::}g; + next unless $p =~ /\A[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*\Z/; + next if $CWD->subsumes( $INC{$pkg_as_path} ); + + push @packages, $p; } my %versions = map { From 2a1c2a7c1804049cf75b88f9e2cc40ab4e13c2f5 Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Thu, 6 Feb 2014 11:40:07 +0100 Subject: [PATCH 4/9] Drop dependency on Path::Tiny, no longer chdir in our END block --- Changes | 2 ++ cpanfile | 3 +-- lib/Test/DiagINC.pm | 17 ++++++++++++----- t/basic.t | 1 - 4 files changed, 15 insertions(+), 8 deletions(-) diff --git a/Changes b/Changes index 7a90947..3d2251c 100644 --- a/Changes +++ b/Changes @@ -4,6 +4,8 @@ Revision history for Test-DiagINC - Minimize amount of reported modules: anything Test::DiagINC loads in order to compile the report is excluded + - No longr chdir() during the local-library heuristic + - No non-core runtime dependencies, add 5.6 support 0.002 2014-02-04 22:17:58-05:00 America/New_York diff --git a/cpanfile b/cpanfile index 598cea7..a3de3d1 100644 --- a/cpanfile +++ b/cpanfile @@ -1,5 +1,4 @@ -requires "Path::Tiny" => "0"; -requires "perl" => "5.008001"; +requires "perl" => "5.006"; requires "strict" => "0"; requires "warnings" => "0"; diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index 470fdc4..201e2a2 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -1,4 +1,4 @@ -use 5.008001; +use 5.006; package Test::DiagINC; # ABSTRACT: List modules and versions loaded if tests fail @@ -32,17 +32,24 @@ END { # make sure we report only on stuff that was loaded by the test, nothing more my @INC_list = keys %INC; - require Path::Tiny; - my $CWD = Path::Tiny::path($REALPATH_CWD); + require File::Spec; + require Cwd; - chdir $CWD; # improve resolution of relative path names my @packages; for my $pkg_as_path ( sort @INC_list ) { next unless defined $INC{$pkg_as_path}; next unless (my $p = $pkg_as_path) =~ s/\.pm\z//; $p =~ s{/}{::}g; next unless $p =~ /\A[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*\Z/; - next if $CWD->subsumes( $INC{$pkg_as_path} ); + + next if ( + # rel2abs on an absolute path is a noop + # https://metacpan.org/source/SMUELLER/PathTools-3.40/lib/File/Spec/Unix.pm#L474 + # https://metacpan.org/source/SMUELLER/PathTools-3.40/lib/File/Spec/Win32.pm#L324 + Cwd::realpath( File::Spec->rel2abs( $INC{$pkg_as_path}, $REALPATH_CWD ) ) + =~ + m| \A \Q$REALPATH_CWD\E [\\\/] |x + ); push @packages, $p; } diff --git a/t/basic.t b/t/basic.t index 353cd5b..5ef224f 100644 --- a/t/basic.t +++ b/t/basic.t @@ -1,4 +1,3 @@ -use 5.008001; use strict; use warnings; use Test::More 0.96; From 9104e1d7a9ff3627fa9885e9af6b758b78e8d444 Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Thu, 6 Feb 2014 11:45:39 +0100 Subject: [PATCH 5/9] Reduce minimum C::T version (did not have any code-changes since 0.21) --- cpanfile | 2 +- t/basic.t | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cpanfile b/cpanfile index a3de3d1..39b31c2 100644 --- a/cpanfile +++ b/cpanfile @@ -3,7 +3,7 @@ requires "strict" => "0"; requires "warnings" => "0"; on 'test' => sub { - requires "Capture::Tiny" => "0.23"; + requires "Capture::Tiny" => "0.21"; requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec::Functions" => "0"; requires "List::Util" => "0"; diff --git a/t/basic.t b/t/basic.t index 5ef224f..6f6edf9 100644 --- a/t/basic.t +++ b/t/basic.t @@ -1,7 +1,7 @@ use strict; use warnings; use Test::More 0.96; -use Capture::Tiny 0.23 qw/capture/; +use Capture::Tiny 0.21 qw/capture/; for my $file (qw/fails.t dies.t/) { $ENV{AUTOMATED_TESTING} = 1; From f9bd47170e02336ddd52005d587e569813e0f544 Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Thu, 6 Feb 2014 12:07:43 +0100 Subject: [PATCH 6/9] More robust error detection, add fail-in-END support Also drop the T::B version requirement (doing so is cheap, and the module scope warrants it) --- Changes | 2 ++ cpanfile | 2 +- examples/fails.t | 2 +- examples/fails_in_end.t | 13 ++++++++ lib/Test/DiagINC.pm | 68 +++++++++++++++++++++++++++++++-------- t/basic.t | 10 ++++-- t/leanload.t | 12 ++++--- t/lib/B_laced_INC_dump.pm | 13 ++++++++ 8 files changed, 99 insertions(+), 23 deletions(-) create mode 100644 examples/fails_in_end.t create mode 100644 t/lib/B_laced_INC_dump.pm diff --git a/Changes b/Changes index 3d2251c..29a40d5 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,8 @@ Revision history for Test-DiagINC {{$NEXT}} + - More robust error condition detection - now triggers on failures + in END-block-based test modules (e.g. Test::NoWarnings) - Minimize amount of reported modules: anything Test::DiagINC loads in order to compile the report is excluded - No longr chdir() during the local-library heuristic diff --git a/cpanfile b/cpanfile index 39b31c2..7c73ddc 100644 --- a/cpanfile +++ b/cpanfile @@ -7,7 +7,7 @@ on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec::Functions" => "0"; requires "List::Util" => "0"; - requires "Test::More" => "0.96"; + requires "Test::More" => "0"; requires "version" => "0"; }; diff --git a/examples/fails.t b/examples/fails.t index 948810e..5857424 100644 --- a/examples/fails.t +++ b/examples/fails.t @@ -1,7 +1,7 @@ use strict; use warnings; -use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use Test::More tests => 1; +use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use ExtUtils::MakeMaker (); use lib 'examples/lib'; use Foo; diff --git a/examples/fails_in_end.t b/examples/fails_in_end.t new file mode 100644 index 0000000..627f3ad --- /dev/null +++ b/examples/fails_in_end.t @@ -0,0 +1,13 @@ +use strict; +use warnings; + +# simulate what a Test::NoWarnings invocation looks like +use Test::More tests => 1; +END { fail("this failed") } + +use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; +use ExtUtils::MakeMaker (); +use lib 'examples/lib'; +use Foo; + + diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index 201e2a2..65de236 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -26,17 +26,48 @@ my $REALPATH_CWD = `$^X -MCwd -e print+getcwd`; my $ORIGINAL_PID = $$; END { - # Dump %INC if in the main process and have a non-zero exit code - if ( $$ == $ORIGINAL_PID && $? ) { - - # make sure we report only on stuff that was loaded by the test, nothing more + if ( $$ == $ORIGINAL_PID ) { + # make sure we report only on stuff that was loaded by the test, + # nothing more + # get a snapshot early in order to not misreport B.pm and friends + # below - this *will* skip any extra modules loaded in END, it was + # deemed an acceptable compromise by ribasushi and xdg my @INC_list = keys %INC; + # If we meet the "fail" criteria - no need to load B and fire + # an extra check in an extra END (also doesn't work on 5.6) + if ( _assert_no_fail(@INC_list) and $] >= 5.008) { + + # we did not report anything yet - add an extra END to catch + # possible future-fails + require B; + push @{ B::end_av()->object_2svref }, sub { + _assert_no_fail(@INC_list) + }; + } + } +} + +# Dump %INC IFF in the main process and test is failing or exit is non-zero +# return true if no failure or if PID mismatches, return false otherwise +sub _assert_no_fail { + + return 1 if $$ != $ORIGINAL_PID; + + if ( $? or ( + $INC{'Test/Builder.pm'} + and + Test::Builder->can('is_passing') + and + ! Test::Builder->new->is_passing + ) ) { + + require Cwd; require File::Spec; require Cwd; my @packages; - for my $pkg_as_path ( sort @INC_list ) { + for my $pkg_as_path ( sort @_ ) { next unless defined $INC{$pkg_as_path}; next unless (my $p = $pkg_as_path) =~ s/\.pm\z//; $p =~ s{/}{::}g; @@ -73,7 +104,11 @@ END { print STDERR "# $header"; printf( STDERR "#$format", $vl, $versions{$_}, -$ml, $_ ) for @packages; } + + return 0; } + + return 1; } 1; @@ -82,7 +117,7 @@ END { =head1 SYNOPSIS - # Load *BEFORE* Test::More + # preferably load before anything else use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use Test::More; @@ -95,9 +130,11 @@ diagnose deep dependency problems by showing you exactly what modules and versions were loaded during a test run. When this module is loaded, it sets up an C block that will take action if -a program exits with a non-zero exit code. If that happens, this module prints -out the names and version numbers of non-local modules appearing in C<%INC> at -the end of the test. +the program is about to exit with a non-zero exit code or if +L<< $test_builder->is_passing|Test::Builder/is_passing >> +is false by the time the C block is reached. If that happens, this module +prints out the names and version numbers of non-local modules appearing in +L<%INC|perlvar/%INC> at the end of the test. For example: @@ -133,10 +170,14 @@ invocation will look like this: # Listing modules from %INC # 0.003 Test::DiagINC -B: Because this module uses an C block, it must be loaded B -C so that the C's C block has a chance to set -the exit code first. If you're not using C, then it's up to you to -ensure your code generates the non-zero exit code (e.g. C or C). +B: Because this module uses an C block, it is a good idea to load +it as early as possible, so the C block it installs will execute as +B as possible (see L for details on how this works). While +this module does employ some cleverness to work around load order, it is +still a heuristic and is no substitute to loading this module early. A notable +side-effect is when a module is loaded in an C block executing B +the one installed by this library: such modules will be "invisible" to us and +will not be reported as part of the diagnostic report. Modules that appear to be sourced from below the current directory when C was loaded will be excluded from the report (e.g. excludes @@ -148,7 +189,6 @@ path loaded does not map to a package within the module file. If C is loaded, the output will go via the C function. Otherwise, it will just be sent to STDERR. - =cut # vim: ts=4 sts=4 sw=4 et: diff --git a/t/basic.t b/t/basic.t index 6f6edf9..3275ec5 100644 --- a/t/basic.t +++ b/t/basic.t @@ -1,9 +1,14 @@ use strict; use warnings; -use Test::More 0.96; +use Test::More; use Capture::Tiny 0.21 qw/capture/; -for my $file (qw/fails.t dies.t/) { +my @testfiles = qw/fails.t dies.t/; +push @testfiles, 'fails_in_end.t' unless $] < 5.008; + +plan tests => @testfiles * 3; + +for my $file (@testfiles) { $ENV{AUTOMATED_TESTING} = 1; my ( $stdout, $stderr ) = capture { system( $^X, "examples/$file" ); @@ -14,7 +19,6 @@ for my $file (qw/fails.t dies.t/) { unlike( $stderr, qr/Foo/, "$file: Did not see local module Foo in module list", ); } -done_testing; # COPYRIGHT # vim: ts=4 sts=4 sw=4 et: diff --git a/t/leanload.t b/t/leanload.t index 9cc2c9e..158e755 100644 --- a/t/leanload.t +++ b/t/leanload.t @@ -17,12 +17,16 @@ BEGIN { require strict && strict->import; } - @::initial_INC = keys %INC + @::initial_INC = keys %INC; + + unless ($] < 5.008) { + @::B_inc = split /\0/, `$^X -Mt::lib::B_laced_INC_dump`; + } } my $nongreat_success; END { - cmp_inc_contents( @::initial_INC, 'Test/DiagINC.pm' ); + cmp_inc_contents( @::initial_INC, 'Test/DiagINC.pm', @::B_inc ); print "1..4\n"; $? ||= ( $nongreat_success || 0 ); } @@ -30,8 +34,9 @@ END { sub cmp_inc_contents { my %current_inc = %INC; - my @leftover_keys; + my ($seen, @leftover_keys); for (@_) { + next if $seen->{$_}++; if (exists $current_inc{$_}) { delete $current_inc{$_} } @@ -64,7 +69,6 @@ sub cmp_inc_contents { $nongreat_success += $fail; } - use Test::DiagINC; BEGIN { cmp_inc_contents( @::initial_INC, 'Test/DiagINC.pm' ) } diff --git a/t/lib/B_laced_INC_dump.pm b/t/lib/B_laced_INC_dump.pm new file mode 100644 index 0000000..41974a8 --- /dev/null +++ b/t/lib/B_laced_INC_dump.pm @@ -0,0 +1,13 @@ +my %inc_copy = %INC; +delete $inc_copy{+__FILE__}; + +if (keys %inc_copy) { + print STDERR "%INC can not be populated when loading @{[ __FILE__ ]}\n"; + exit 255; +} + +require B; + +print join "\0", sort grep { $_ ne __FILE__ } keys %INC; + +exit 0; From fb4991eeb056cd7f10e24c24ab6e56954a2f4167 Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Thu, 6 Feb 2014 13:53:30 +0100 Subject: [PATCH 7/9] Rewrite diag generator for easier modification (no func. changes) --- lib/Test/DiagINC.pm | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index 65de236..688e2c6 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -90,19 +90,25 @@ sub _assert_no_fail { $_ => defined($v) ? $v : "undef" } @packages; - my $header = "Listing modules from %INC\n"; - my $format = " %*s %*s\n"; - my $ml = _max_length(@packages); - my $vl = _max_length( values %versions ); + my $diag = "Listing modules from %INC\n"; + + my $ml = _max_length(@packages); + my $vl = _max_length( values %versions ); + + for (@packages) { + $diag .= sprintf( " %*s %*s\n", + # pairs of [ padding-length => content ] + $vl => $versions{$_}, + -$ml => $_ + ) + } if ( $INC{"Test/Builder.pm"} ) { - my $tb = Test::Builder->new; - $tb->diag($header); - $tb->diag( sprintf( $format, $vl, $versions{$_}, -$ml, $_ ) ) for @packages; + Test::Builder->new->diag($diag); } else { - print STDERR "# $header"; - printf( STDERR "#$format", $vl, $versions{$_}, -$ml, $_ ) for @packages; + $diag =~ s/^/# /mg; + print STDERR $diag; } return 0; From 313d72464291f04db263b23897d276f3540aba34 Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Thu, 6 Feb 2014 14:13:13 +0100 Subject: [PATCH 8/9] Add diagnostic of "Attempted-but-failed-to-load" on perl >= 5.10 May very well be useful for conditional A/B dep diag --- Changes | 1 + examples/dies.t | 1 + examples/fails.t | 1 + examples/fails_in_end.t | 1 + examples/lib/SyntaxErr.pm | 3 +++ lib/Test/DiagINC.pm | 38 +++++++++++++++++++++++++------------- t/basic.t | 5 ++++- 7 files changed, 36 insertions(+), 14 deletions(-) create mode 100644 examples/lib/SyntaxErr.pm diff --git a/Changes b/Changes index 29a40d5..3203cb5 100644 --- a/Changes +++ b/Changes @@ -4,6 +4,7 @@ Revision history for Test-DiagINC - More robust error condition detection - now triggers on failures in END-block-based test modules (e.g. Test::NoWarnings) + - Add diagnostic of "Attempted-but-failed-to-load" on perl >= 5.10 - Minimize amount of reported modules: anything Test::DiagINC loads in order to compile the report is excluded - No longr chdir() during the local-library heuristic diff --git a/examples/dies.t b/examples/dies.t index 795a02b..b81c9a0 100644 --- a/examples/dies.t +++ b/examples/dies.t @@ -3,6 +3,7 @@ use warnings; use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use ExtUtils::MakeMaker; use examples::lib::Foo; +eval { require examples::lib::SyntaxErr }; chdir ".." or die "$!"; # try to mess up relative entry in %INC diff --git a/examples/fails.t b/examples/fails.t index 5857424..7ceac1b 100644 --- a/examples/fails.t +++ b/examples/fails.t @@ -5,5 +5,6 @@ use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use ExtUtils::MakeMaker (); use lib 'examples/lib'; use Foo; +eval { require SyntaxErr }; fail("this failed"); diff --git a/examples/fails_in_end.t b/examples/fails_in_end.t index 627f3ad..33f47ae 100644 --- a/examples/fails_in_end.t +++ b/examples/fails_in_end.t @@ -9,5 +9,6 @@ use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use ExtUtils::MakeMaker (); use lib 'examples/lib'; use Foo; +eval { require SyntaxErr }; diff --git a/examples/lib/SyntaxErr.pm b/examples/lib/SyntaxErr.pm new file mode 100644 index 0000000..390f793 --- /dev/null +++ b/examples/lib/SyntaxErr.pm @@ -0,0 +1,3 @@ +asphinctersayswhat + +0; diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index 688e2c6..3bc382c 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -66,13 +66,24 @@ sub _assert_no_fail { require File::Spec; require Cwd; - my @packages; - for my $pkg_as_path ( sort @_ ) { - next unless defined $INC{$pkg_as_path}; + my %results; + + for my $pkg_as_path ( @_ ) { next unless (my $p = $pkg_as_path) =~ s/\.pm\z//; $p =~ s{/}{::}g; next unless $p =~ /\A[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*\Z/; + # a module we recorded as INCed disappeared... + if (not exists $INC{$pkg_as_path}) { + $results{$p} = 'Module unloaded in END...?'; + next; + } + + if (not defined $INC{$pkg_as_path} ) { + $results{$p} = 'Found and failed to load'; + next; + } + next if ( # rel2abs on an absolute path is a noop # https://metacpan.org/source/SMUELLER/PathTools-3.40/lib/File/Spec/Unix.pm#L474 @@ -82,23 +93,24 @@ sub _assert_no_fail { m| \A \Q$REALPATH_CWD\E [\\\/] |x ); - push @packages, $p; + my $ver = do { + local $@; + my $v = eval { $p->VERSION }; + $@ ? '->VERSION call failed' : $v + }; + $ver = 'n/a' unless defined $ver; + $results{$p} = $ver; } - my %versions = map { - my $v = eval { $_->VERSION }; - $_ => defined($v) ? $v : "undef" - } @packages; - my $diag = "Listing modules from %INC\n"; - my $ml = _max_length(@packages); - my $vl = _max_length( values %versions ); + my $ml = _max_length( keys %results ); + my $vl = _max_length( values %results ); - for (@packages) { + for (sort keys %results) { $diag .= sprintf( " %*s %*s\n", # pairs of [ padding-length => content ] - $vl => $versions{$_}, + $vl => $results{$_}, -$ml => $_ ) } diff --git a/t/basic.t b/t/basic.t index 3275ec5..f4afb2c 100644 --- a/t/basic.t +++ b/t/basic.t @@ -6,7 +6,7 @@ use Capture::Tiny 0.21 qw/capture/; my @testfiles = qw/fails.t dies.t/; push @testfiles, 'fails_in_end.t' unless $] < 5.008; -plan tests => @testfiles * 3; +plan tests => @testfiles * ($] < 5.010 ? 3 : 4); for my $file (@testfiles) { $ENV{AUTOMATED_TESTING} = 1; @@ -17,6 +17,9 @@ for my $file (@testfiles) { like( $stderr, qr/\QListing modules from %INC/, "$file: Saw diagnostic header" ); like( $stderr, qr/[0-9.]+\s+ExtUtils::MakeMaker/, "$file: Saw EUMM in module list" ); unlike( $stderr, qr/Foo/, "$file: Did not see local module Foo in module list", ); + + like( $stderr, qr/Found and failed to load\s+[\w\:]*SyntaxErr/, + "$file: Saw failed load attempt of SyntaxErr" ) unless $] < 5.010; } # COPYRIGHT From d33e73ee75019ba98615da88ede82f32bed2c78f Mon Sep 17 00:00:00 2001 From: Peter Rabbitson Date: Fri, 7 Feb 2014 06:38:40 +0100 Subject: [PATCH 9/9] Make sure everything still runs under taint mode --- lib/Test/DiagINC.pm | 7 ++++++- t/basic.t | 16 ++++++++++++++-- t/taint.t | 17 +++++++++++++++++ 3 files changed, 37 insertions(+), 3 deletions(-) create mode 100644 t/taint.t diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index 3bc382c..ecaf3f3 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -22,7 +22,12 @@ sub _max_length { # Get our CWD *without* loading anything. Original idea by xdg++ # ribasushi thinks this is fragile and will break sooner rather than # later, but adding it as is because haarg and xdg both claim it's fine -my $REALPATH_CWD = `$^X -MCwd -e print+getcwd`; +my $REALPATH_CWD = do { + local $ENV{PATH}; + my ($perl) = $^X =~ /(.+)/; # $^X is internal how could it be tainted?! + `$perl -MCwd -e print+getcwd`; +}; + my $ORIGINAL_PID = $$; END { diff --git a/t/basic.t b/t/basic.t index f4afb2c..3eb21dc 100644 --- a/t/basic.t +++ b/t/basic.t @@ -8,10 +8,22 @@ push @testfiles, 'fails_in_end.t' unless $] < 5.008; plan tests => @testfiles * ($] < 5.010 ? 3 : 4); +my $tainted_run = ! eval { $ENV{PATH} . kill(0) and 1 } + and diag ( __FILE__ . ' running under taint mode' ); + +local $ENV{AUTOMATED_TESTING} = 1; + +# untaint PATH but do not unset it so we test that $^X will +# run with it just fine +local ( $ENV{PATH} ) = $ENV{PATH} =~ /(.*)/ if $tainted_run; + for my $file (@testfiles) { - $ENV{AUTOMATED_TESTING} = 1; my ( $stdout, $stderr ) = capture { - system( $^X, "examples/$file" ); + system( + ($^X =~ /(.+)/), # $^X is internal how can it be tainted?! + ( $tainted_run ? (qw( -I . -I lib -T )) : () ), + "examples/$file" + ); }; like( $stderr, qr/\QListing modules from %INC/, "$file: Saw diagnostic header" ); diff --git a/t/taint.t b/t/taint.t new file mode 100644 index 0000000..4882dfd --- /dev/null +++ b/t/taint.t @@ -0,0 +1,17 @@ +use warnings; +use strict; +use File::Spec; + +# there is talk of possible perl compilations where -T is a fatal +# we don't want to have the user deal with that +system( $^X => -T => -e => 'use warnings; use strict; exit 0' ); +if ($?) { + print "1..0 # SKIP Your perl does not seem to like -T...\n"; + exit 0; +} + +# all is well - just rerun the basic test +exec( $^X => -T => File::Spec->catpath( + (File::Spec->splitpath( __FILE__ ))[0,1], + 'basic.t' +) );