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