t/strictures.t

   1 BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} }
   2
   3 # -e is sufficient here.
   4 -e 't/smells-of-vcs/.git'
   5   or mkdir('t/smells-of-vcs/.git')
   6   or die "Couldn't create fake .git: $!";
   7
   8 use Test::More qw(no_plan);
   9
  10 our (@us, @expect);
  11
  12 sub capture_stuff { [ $^H, ${^WARNING_BITS} ] }
  13
  14 sub capture_us { push @us, capture_stuff }
  15 sub capture_expect { push @expect, capture_stuff }
  16
  17 {
  18   BEGIN { $ENV{PERL_STRICTURES_EXTRA} = 0 }
  19   use strictures 1;
  20   BEGIN { capture_us }
  21   BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} }
  22 }
  23
  24 {
  25   use strict;
  26   use warnings FATAL => 'all';
  27   BEGIN { capture_expect }
  28 }
  29
  30 # I'm assuming here we'll have more cases later. maybe not. eh.
  31
  32 foreach my $idx (0 .. $#us) {
  33   is($us[$idx][0], $expect[$idx][0], 'Hints ok for case '.($idx+1));
  34   is($us[$idx][1], $expect[$idx][1], 'Warnings ok for case '.($idx+1));
  35 }
  36
  37 my $v;
  38 eval { $v = strictures->VERSION; 1 } or diag $@;
  39 is $v, $strictures::VERSION, '->VERSION returns version correctly';
  40
  41 SKIP: {
  42   skip 'Extra tests disabled on perls <= 5.008003', 1
  43     if $] < 5.008004;
  44   skip 'Not got all the modules to do this', 1
  45     unless eval {
  46       require indirect;
  47       require multidimensional;
  48       require bareword::filehandles;
  49       1;
  50     };
  51   sub Foo::new { 1 }
  52   chdir("t/smells-of-vcs");
  53   local $strictures::Smells_Like_VCS = 1;
  54   foreach my $file (qw(lib/one.pm t/one.faket)) {
  55     ok(!eval { require $file; 1 }, "Failed to load ${file}");
  56     like($@, qr{Indirect call of method}, "Failed due to indirect.pm, ok");
  57   }
  58   ok(eval { require "other/one.pl"; 1 }, "Loaded other/one.pl ok");
  59   chdir("../..");
  60 }
  61
  62 ok(!eval q{use strictures 2; 1; }, "Can't use strictures 2 (this is version 1)");
  63
  64 SKIP: {
  65   skip 'Extra tests disabled on perls <= 5.008003', 1
  66     if $] < 5.008004;
  67   local $ENV{PERL_STRICTURES_EXTRA} = 1;
  68   local $strictures::extra_load_states = undef;
  69   local @INC = ("t/dep_constellations/broken", @INC);
  70   local %INC = %INC;
  71   delete $INC{$_}
  72     for qw( indirect.pm multidimensional.pm bareword/filehandles.pm );
  73
  74   {
  75     open my $fh, '>', \my $str;
  76     local *STDERR = $fh;
  77     strictures->import;
  78     like(
  79       $str,
  80       qr/Missing were:\n\n  indirect multidimensional bareword::filehandles/,
  81       "failure to load all three extra deps is reported"
  82     );
  83   }
  84
  85   {
  86     open my $fh, '>', \my $str;
  87     local *STDERR = $fh;
  88     strictures->import;
  89     ok( !$str, "extra dep load failure is not reported a second time" );
  90   }
  91 }