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 15bd668529a51f4017070e6ba57e877c7c5523ec 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 | 54 +++++++++++++++++++++++++++------- t/basic.t | 3 +- t/leanload.t | 70 +++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 120 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..22487fc 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,34 @@ sub _max_length { return $max; } +# Get our CWD *without* loading anything. The original idea by xdg++ was to +# invoke a with an -e snippet, and not worry about quoting, but it seemed too +# fragile. doing this trick instead (we know we can load ourselves): +BEGIN { + if ($^C) { + require Cwd; + require POSIX; + $|++; + print Cwd::getcwd() . "\n"; + POSIX::_exit(0); + } +} +chomp( my $REALPATH_CWD = `$^X -c @{[ __FILE__ ]}` ); 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 +111,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 +122,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 +139,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 +147,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 366733960fcde286de086bb6c53b38a5480ad159 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 22487fc..ee7076b 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -46,11 +46,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 6bb51e5623179e84ecb8dcc31e448652e3a00c0b 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 ee7076b..9205841 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 @@ -41,17 +41,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 851565fc5ae8b514f6290837d5dba343a8926caf 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 cf216bcaaaf74c30a45ccf6d4330742f4fe46d5e 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 9205841..af0e3cc 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -35,17 +35,48 @@ chomp( my $REALPATH_CWD = `$^X -c @{[ __FILE__ ]}` ); 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; @@ -82,7 +113,11 @@ END { print STDERR "# $header"; printf( STDERR "#$format", $vl, $versions{$_}, -$ml, $_ ) for @packages; } + + return 0; } + + return 1; } 1; @@ -91,7 +126,7 @@ END { =head1 SYNOPSIS - # Load *BEFORE* Test::More + # preferably load before anything else use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use Test::More; @@ -104,9 +139,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: @@ -142,10 +179,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 @@ -157,7 +198,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 1a49ecca5d017ee5392117128a5166086101562f 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 af0e3cc..ad0902b 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -99,19 +99,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 528faa5d577098354e99a3c38cb700dbb5298e27 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 ad0902b..b1f8646 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -75,13 +75,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 @@ -91,23 +102,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 05d6dc8260d3e0c9c2898e9e588e84cc81b7f3f4 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 | 6 +++++- t/basic.t | 16 ++++++++++++++-- t/taint.t | 17 +++++++++++++++++ 3 files changed, 36 insertions(+), 3 deletions(-) create mode 100644 t/taint.t diff --git a/lib/Test/DiagINC.pm b/lib/Test/DiagINC.pm index b1f8646..ef31c4d 100644 --- a/lib/Test/DiagINC.pm +++ b/lib/Test/DiagINC.pm @@ -31,7 +31,11 @@ BEGIN { POSIX::_exit(0); } } -chomp( my $REALPATH_CWD = `$^X -c @{[ __FILE__ ]}` ); +chomp( my $REALPATH_CWD = do { + local $ENV{PATH}; + my ($perl) = $^X =~ /(.+)/; # $^X is internal how could it be tainted?! + `$perl -c @{[ __FILE__ ]}`; +}); 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' +) );