From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 21 Jun 2016 09:07:45 +0000 (+0200)
Subject: Fix describe_env failure on nonexistent @INC on Win32
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=40097e4976c45a079edf12d6ea24db15728185a1;p=dbsrgits%2FDBIx-Class.git

Fix describe_env failure on nonexistent @INC on Win32

( cherry picks of ba35e8ec, 2c038b0a and 6c7ca962 )

Despite this code undergoing wide CPAN testing last year, and having zero
functional changes since, there were *still* bugs lurking inside :/
---

diff --git a/t/00describe_environment.t b/t/00describe_environment.t
index b020ca1..13cb79b 100644
--- a/t/00describe_environment.t
+++ b/t/00describe_environment.t
@@ -53,6 +53,15 @@ use strict;
 use warnings;
 
 use Test::More 'no_plan';
+
+# Things happen... unfortunately
+$SIG{__DIE__} = sub {
+  die unless defined $^S and ! $^S;
+
+  diag "Something horrible happened while assembling the diag data\n$_[0]";
+  exit 0;
+};
+
 use Config;
 use File::Find 'find';
 use Digest::MD5 ();
@@ -416,9 +425,10 @@ my $max_ver_len = max map
 ;
 my $max_marker_len = max map { length $_ } ( '$INC[999]', keys %$seen_markers );
 
+# Note - must be less than 76 chars wide to account for the diag() prefix
 my $discl = <<'EOD';
 
-List of loadable modules within both the core and *OPTIONAL* dependency chains
+List of loadable modules within both *OPTIONAL* and core 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)
 
@@ -532,12 +542,18 @@ sub abs_unix_path {
 
   # File::Spec's rel2abs does not resolve symlinks
   # we *need* to look at the filesystem to be sure
-  my $abs_fn = abs_path($_[0]);
+  #
+  # But looking at the FS for non-existing basenames *may*
+  # throw on some OSes so be extra paranoid:
+  # http://www.cpantesters.org/cpan/report/26a6e42f-6c23-1014-b7dd-5cd275d8a230
+  #
+  my $abs_fn = eval { abs_path($_[0]) } || '';
 
-  if ( $^O eq 'MSWin32' and $abs_fn ) {
+  if ( $abs_fn and $^O eq 'MSWin32' ) {
 
     # sometimes we can get a short/longname mix, normalize everything to longnames
-    $abs_fn = Win32::GetLongPathName($abs_fn);
+    $abs_fn = Win32::GetLongPathName($abs_fn)
+      if -e $abs_fn;
 
     # Fixup (native) slashes in Config not matching (unixy) slashes in INC
     $abs_fn =~ s|\\|/|g;
@@ -551,7 +567,7 @@ sub shorten_fn {
 
   my $abs_fn = abs_unix_path($fn);
 
-  if (my $p = subpath_of_known_path( $fn ) ) {
+  if ($abs_fn and my $p = subpath_of_known_path( $fn ) ) {
     $abs_fn =~ s| (?<! / ) $|/|x
       if -d $abs_fn;