t/extras.t

   1 BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} }
   2 use strict;
   3 use warnings;
   4 use Test::More $] >= 5.008_004 ? qw(no_plan)
   5   : (skip_all => 'Extra tests disabled on perls <= 5.008003');
   6
   7 use File::Temp;
   8
   9 my $tempdir = File::Temp::tempdir(CLEANUP => 1, TMPDIR => 1);
  10 chdir $tempdir;
  11
  12 my %extras;
  13 BEGIN {
  14   %extras = map { $_ => 1 } qw(
  15     indirect.pm
  16     multidimensional.pm
  17     bareword/filehandles.pm
  18   );
  19   $INC{$_} = __FILE__
  20     for keys %extras;
  21 }
  22
  23 use strictures ();
  24
  25 my $indirect = 0;
  26 sub indirect::unimport {
  27   $indirect++;
  28 };
  29
  30 {
  31   local $strictures::Smells_Like_VCS = undef;
  32   eval qq{
  33 #line 1 "t/nogit.t"
  34 use strictures;
  35 1;
  36 } or die "$@";
  37   ok defined $strictures::Smells_Like_VCS, 'VCS dir has been checked';
  38   ok !$strictures::Smells_Like_VCS,        'VCS dir not detected with no .git';
  39 }
  40
  41 mkdir '.git';
  42
  43 {
  44   local $strictures::Smells_Like_VCS = undef;
  45   eval qq{
  46 #line 1 "t/withgit.t"
  47 use strictures;
  48 1;
  49 } or die "$@";
  50   ok defined $strictures::Smells_Like_VCS, 'VCS dir has been checked';
  51   ok $strictures::Smells_Like_VCS,         'VCS dir detected with .git';
  52 }
  53
  54 $strictures::Smells_Like_VCS = 1;
  55
  56 for my $check (
  57   ["file.pl"            => 0],
  58   ["test.pl"            => 0],
  59   ["library.pm"         => 0],
  60   ["t/test.t"           => 1],
  61   ["xt/test.t"          => 1],
  62   ["t/one.faket"        => 1],
  63   ["lib/module.pm"      => 1],
  64   ["other/one.pl"       => 0],
  65   ["other/t/test.t"     => 0],
  66   ["blib/module.pm"     => 1],
  67 ) {
  68   my ($file, $want) = @$check;
  69   $indirect = 0;
  70   eval qq{
  71 #line 1 "$file"
  72 use strictures;
  73 1;
  74   } or die "$@";
  75   my $not = $want ? '' : ' not';
  76   is $indirect, $want,
  77     "file named $file does$not get extras";
  78 }
  79
  80 {
  81   local $ENV{PERL_STRICTURES_EXTRA} = 1;
  82   local $strictures::extra_load_states = undef;
  83   local @INC = (sub {
  84     die "Can't locate $_[1] in \@INC (...).\n"
  85       if $extras{$_[1]};
  86   }, @INC);
  87   local %INC = %INC;
  88   delete $INC{$_}
  89     for keys %extras;
  90
  91   {
  92     open my $fh, '>', \(my $str = '');
  93     local *STDERR = $fh;
  94     eval qq{
  95 #line 1 "t/load_fail.t"
  96 use strictures;
  97 1;
  98     } or die "$@";
  99
 100     strictures->import;
 101     like(
 102       $str,
 103       qr/Missing were:\n\n  indirect multidimensional bareword::filehandles/,
 104       "failure to load all three extra deps is reported"
 105     );
 106   }
 107
 108   {
 109     open my $fh, '>', \(my $str = '');
 110     local *STDERR = $fh;
 111     eval qq{
 112 #line 1 "t/load_fail.t"
 113 use strictures;
 114 1;
 115     } or die "$@";
 116     is $str, '', "extra dep load failure is not reported a second time";
 117   }
 118 }