factor out env check from file check
[p5sagit/strictures.git] / 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 = ();
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     {
94       local *STDERR = $fh;
95       eval qq{
96 #line 1 "t/load_fail.t"
97 use strictures;
98 1;
99       } or die "$@";
100     }
101
102     strictures->import;
103     like(
104       $str,
105       qr/Missing were:\n\n  indirect multidimensional bareword::filehandles/,
106       "failure to load all three extra deps is reported"
107     );
108   }
109
110   {
111     open my $fh, '>', \(my $str = '');
112     {
113       local *STDERR = $fh;
114       eval qq{
115 #line 1 "t/load_fail.t"
116 use strictures;
117 1;
118       } or die "$@";
119     }
120
121     is $str, '', "extra dep load failure is not reported a second time";
122   }
123 }