Stuffz+

Changes

@@ -2,6 +2,14 @@ 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)
+    - 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
+    - No non-core runtime dependencies, add 5.6 support
+
 0.002     2014-02-04 22:17:58-05:00 America/New_York
 
     [CHANGED]

cpanfile

@@ -1,14 +1,13 @@
-requires "Path::Tiny" => "0";
-requires "perl" => "5.008001";
+requires "perl" => "5.006";
 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";
-  requires "Test::More" => "0.96";
+  requires "Test::More" => "0";
   requires "version" => "0";
 };
 

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
 

examples/fails.t

@@ -1,8 +1,10 @@
 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;
+eval { require SyntaxErr };
 
 fail("this failed");

examples/fails_in_end.t

@@ -0,0 +1,14 @@
+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;
+eval { require SyntaxErr };
+
+

examples/lib/SyntaxErr.pm

@@ -0,0 +1,3 @@
+asphinctersayswhat
+
+0;

lib/Test/DiagINC.pm

@@ -1,12 +1,16 @@
-use 5.008001;
-use strict;
-use warnings;
+use 5.006;
 
 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,41 +19,119 @@ 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 = do {
+    local $ENV{PATH};
+    my ($perl) = $^X =~ /(.+)/; # $^X is internal how could it be tainted?!
+    `$perl -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 && $? ) {
-        chdir $CWD; # improve resolution of relative path names
-        my @packages;
-        for my $p ( sort keys %INC ) {
-            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/;
+    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 %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
+                # 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
+            );
+
+            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 $header = "Listing modules from %INC\n";
-        my $format = "  %*s %*s\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 (sort keys %results) {
+            $diag .= sprintf( " %*s  %*s\n",
+                # pairs of [ padding-length => content ]
+                $vl   =>  $results{$_},
+                -$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;
     }
+
+    return 1;
 }
 
 1;
@@ -58,7 +140,7 @@ END {
 
 =head1 SYNOPSIS
 
-    # Load *BEFORE* Test::More
+    # preferably load before anything else
     use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC';
     use Test::More;
 
@@ -71,9 +153,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<END> 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<END> 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:
 
@@ -88,29 +172,42 @@ 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
     #       1.03 vars
     #       1.18 warnings
     #       1.02 warnings::register
 
-B<NOTE>:  Because this module uses an C<END> block, it must be loaded B<before>
-C<Test::More> so that the C<Test::More>'s C<END> block has a chance to set
-the exit code first.  If you're not using C<Test::More>, then it's up to you to
-ensure your code generates the non-zero exit code (e.g. C<die()> or C<exit(1)>).
+This module deliberately does not load B<any other modules> during runtime,
+instead delaying all loads until it needs to generate a failure report in its
+C<END> block. The only exception is loading L<strict> and L<warnings> for
+self-check B<if and only if> C<RELEASE_TESTING> 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<NOTE>:  Because this module uses an C<END> block, it is a good idea to load
+it as early as possible, so the C<END> block it installs will execute as
+B<late> as possible (see L<perlmod> 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<END> block executing B<after>
+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<Test::DiagINC> was loaded will be excluded from the report (e.g. excludes
-local modules from C<lib/>, C<t/lib>, and so on).
+local modules from C<./>, C<lib/>, C<t/lib>, 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<Test::More> is loaded, the output will go via the C<diag> function.
 Otherwise, it will just be sent to STDERR.

t/basic.t

@@ -1,20 +1,39 @@
-use 5.008001;
 use strict;
 use warnings;
-use Test::More 0.96;
-use Capture::Tiny 0.23 qw/capture/;
+use Test::More;
+use Capture::Tiny 0.21 qw/capture/;
 
-for my $file (qw/fails.t dies.t/) {
-    $ENV{AUTOMATED_TESTING} = 1;
+my @testfiles = qw/fails.t dies.t/;
+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) {
     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" );
-    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", );
+
+    like( $stderr, qr/Found and failed to load\s+[\w\:]*SyntaxErr/,
+      "$file: Saw failed load attempt of SyntaxErr" ) unless $] < 5.010;
 }
 
-done_testing;
 # COPYRIGHT
 
 # vim: ts=4 sts=4 sw=4 et: