split extras testing into separate file and make it more robust

Change extras testing script to not rely on extras actually being
installed, and use inline evals rather than separate files to make it
more obvious what is being checked.

diff --git a/t/dep_constellations/broken/bareword/filehandles.pm b/t/dep_constellations/broken/bareword/filehandles.pm
deleted file mode 100644 (file)
index e69de29..0000000

diff --git a/t/dep_constellations/broken/indirect.pm b/t/dep_constellations/broken/indirect.pm
deleted file mode 100644 (file)
index e69de29..0000000

diff --git a/t/dep_constellations/broken/multidimensional.pm b/t/dep_constellations/broken/multidimensional.pm
deleted file mode 100644 (file)
index e69de29..0000000

diff --git a/t/extras.t b/t/extras.t
new file mode 100644 (file)
index 0000000..d314290
--- /dev/null
+++ b/t/extras.t
@@ -0,0 +1,118 @@
+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 = undef;
+  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 = '');
+    local *STDERR = $fh;
+    eval qq{
+#line 1 "t/load_fail.t"
+use strictures;
+1;
+    } or die "$@";
+
+    strictures->import;
+    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 = '');
+    local *STDERR = $fh;
+    eval qq{
+#line 1 "t/load_fail.t"
+use strictures;
+1;
+    } or die "$@";
+    is $str, '', "extra dep load failure is not reported a second time";
+  }
+}

diff --git a/t/smells-of-vcs/.exists b/t/smells-of-vcs/.exists
deleted file mode 100644 (file)
index e69de29..0000000

diff --git a/t/smells-of-vcs/lib/one.pm b/t/smells-of-vcs/lib/one.pm
deleted file mode 100644 (file)
index 68e9001..0000000
--- a/t/smells-of-vcs/lib/one.pm
+++ /dev/null
@@ -1,5 +0,0 @@
-package one;
-
-use strictures 1;
-
-new Foo 1, 2, 3;

diff --git a/t/smells-of-vcs/other/one.pl b/t/smells-of-vcs/other/one.pl
deleted file mode 100644 (file)
index 362d179..0000000
--- a/t/smells-of-vcs/other/one.pl
+++ /dev/null
@@ -1,3 +0,0 @@
-use strictures 1;
-
-new Foo 1, 2, 3;

diff --git a/t/smells-of-vcs/t/one.faket b/t/smells-of-vcs/t/one.faket
deleted file mode 100644 (file)
index 362d179..0000000
--- a/t/smells-of-vcs/t/one.faket
+++ /dev/null
@@ -1,3 +0,0 @@
-use strictures 1;
-
-new Foo 1, 2, 3;

diff --git a/t/strictures.t b/t/strictures.t
index 58104fa..9a107ed 100644 (file)
--- a/t/strictures.t
+++ b/t/strictures.t
@@ -1,10 +1,5 @@
 BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} }
 
-# -e is sufficient here.
--e 't/smells-of-vcs/.git'
-  or mkdir('t/smells-of-vcs/.git')
-  or die "Couldn't create fake .git: $!";
-
 use Test::More qw(no_plan);
 
 our (@us, @expect);
@@ -38,54 +33,4 @@ my $v;
 eval { $v = strictures->VERSION; 1 } or diag $@;
 is $v, $strictures::VERSION, '->VERSION returns version correctly';
 
-SKIP: {
-  skip 'Extra tests disabled on perls <= 5.008003', 1
-    if $] < 5.008004;
-  skip 'Not got all the modules to do this', 1
-    unless eval {
-      require indirect;
-      require multidimensional;
-      require bareword::filehandles;
-      1;
-    };
-  sub Foo::new { 1 }
-  chdir("t/smells-of-vcs");
-  local $strictures::Smells_Like_VCS = 1;
-  foreach my $file (qw(lib/one.pm t/one.faket)) {
-    ok(!eval { require $file; 1 }, "Failed to load ${file}");
-    like($@, qr{Indirect call of method}, "Failed due to indirect.pm, ok");
-  }
-  ok(eval { require "other/one.pl"; 1 }, "Loaded other/one.pl ok");
-  chdir("../..");
-}
-
 ok(!eval q{use strictures 2; 1; }, "Can't use strictures 2 (this is version 1)");
-
-SKIP: {
-  skip 'Extra tests disabled on perls <= 5.008003', 1
-    if $] < 5.008004;
-  local $ENV{PERL_STRICTURES_EXTRA} = 1;
-  local $strictures::extra_load_states = undef;
-  local @INC = ("t/dep_constellations/broken", @INC);
-  local %INC = %INC;
-  delete $INC{$_}
-    for qw( indirect.pm multidimensional.pm bareword/filehandles.pm );
-
-  {
-    open my $fh, '>', \my $str;
-    local *STDERR = $fh;
-    strictures->import;
-    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;
-    local *STDERR = $fh;
-    strictures->import;
-    ok( !$str, "extra dep load failure is not reported a second time" );
-  }
-}