remove extraneous strictures import in test

[p5sagit/strictures.git] / t / extras.t

BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} }
use strict;
use warnings;
use Test::More $] >= 5.008_004 ? qw(no_plan)
  : (skip_all => 'Extra tests disabled on perls <= 5.008003');

use File::Temp;

my $tempdir = File::Temp::tempdir(CLEANUP => 1, TMPDIR => 1);
chdir $tempdir;

my %extras;
BEGIN {
  %extras = map { $_ => 1 } qw(
    indirect.pm
    multidimensional.pm
    bareword/filehandles.pm
  );
  $INC{$_} = __FILE__
    for keys %extras;
}

use strictures ();

my $indirect = 0;
sub indirect::unimport {
  $indirect++;
};

{
  local $strictures::Smells_Like_VCS = undef;
  eval qq{
#line 1 "t/nogit.t"
use strictures;
1;
} or die "$@";
  ok defined $strictures::Smells_Like_VCS, 'VCS dir has been checked';
  ok !$strictures::Smells_Like_VCS,        'VCS dir not detected with no .git';
}

mkdir '.git';

{
  local $strictures::Smells_Like_VCS = undef;
  eval qq{
#line 1 "t/withgit.t"
use strictures;
1;
} or die "$@";
  ok defined $strictures::Smells_Like_VCS, 'VCS dir has been checked';
  ok $strictures::Smells_Like_VCS,         'VCS dir detected with .git';
}

$strictures::Smells_Like_VCS = 1;

for my $check (
  ["file.pl"            => 0],
  ["test.pl"            => 0],
  ["library.pm"         => 0],
  ["t/test.t"           => 1],
  ["xt/test.t"          => 1],
  ["t/one.faket"        => 1],
  ["lib/module.pm"      => 1],
  ["other/one.pl"       => 0],
  ["other/t/test.t"     => 0],
  ["blib/module.pm"     => 1],
) {
  my ($file, $want) = @$check;
  $indirect = 0;
  eval qq{
#line 1 "$file"
use strictures;
1;
  } or die "$@";
  my $not = $want ? '' : ' not';
  is $indirect, $want,
    "file named $file does$not get extras";
}

{
  local $ENV{PERL_STRICTURES_EXTRA} = 1;
  local %strictures::extra_load_states = ();
  local @INC = (sub {
    die "Can't locate $_[1] in \@INC (...).\n"
      if $extras{$_[1]};
  }, @INC);
  local %INC = %INC;
  delete $INC{$_}
    for keys %extras;

  {
    open my $fh, '>', \(my $str = '');
    my $e;
    {
      local *STDERR = $fh;
      eval qq{
#line 1 "t/load_fail.t"
use strictures;
1;
      } or $e = "$@";
    }
    die $e if defined $e;

    like(
      $str,
      qr/Missing were:\n\n  indirect multidimensional bareword::filehandles/,
      "failure to load all three extra deps is reported"
    );
  }

  {
    open my $fh, '>', \(my $str = '');
    my $e;
    {
      local *STDERR = $fh;
      eval qq{
#line 1 "t/load_fail.t"
use strictures;
1;
      } or $e = "$@";
    }
    die $e if defined $e;

    is $str, '', "extra dep load failure is not reported a second time";
  }
}