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