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; |
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; |
8f0df510 |
82 | local %strictures::extra_load_states = (); |
8c8a0b9a |
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 = ''); |
9e56bf63 |
93 | my $e; |
b43e54c0 |
94 | { |
95 | local *STDERR = $fh; |
96 | eval qq{ |
8c8a0b9a |
97 | #line 1 "t/load_fail.t" |
98 | use strictures; |
99 | 1; |
9e56bf63 |
100 | } or $e = "$@"; |
b43e54c0 |
101 | } |
9e56bf63 |
102 | die $e if defined $e; |
8c8a0b9a |
103 | |
8c8a0b9a |
104 | like( |
105 | $str, |
106 | qr/Missing were:\n\n indirect multidimensional bareword::filehandles/, |
107 | "failure to load all three extra deps is reported" |
108 | ); |
109 | } |
110 | |
111 | { |
112 | open my $fh, '>', \(my $str = ''); |
9e56bf63 |
113 | my $e; |
b43e54c0 |
114 | { |
115 | local *STDERR = $fh; |
116 | eval qq{ |
8c8a0b9a |
117 | #line 1 "t/load_fail.t" |
118 | use strictures; |
119 | 1; |
9e56bf63 |
120 | } or $e = "$@"; |
b43e54c0 |
121 | } |
9e56bf63 |
122 | die $e if defined $e; |
b43e54c0 |
123 | |
8c8a0b9a |
124 | is $str, '', "extra dep load failure is not reported a second time"; |
125 | } |
126 | } |