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