Commit | Line | Data |
5ab06a4d |
1 | BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} } |
2 | |
13ac7415 |
3 | # -e is sufficient here. |
4 | -e 't/smells-of-vcs/.git' |
5 | or mkdir('t/smells-of-vcs/.git') |
6 | or die "Couldn't create fake .git: $!"; |
abacb15a |
7 | |
eae006ee |
8 | use Test::More qw(no_plan); |
9 | |
10 | our (@us, @expect); |
11 | |
12 | sub capture_stuff { [ $^H, ${^WARNING_BITS} ] } |
13 | |
14 | sub capture_us { push @us, capture_stuff } |
15 | sub capture_expect { push @expect, capture_stuff } |
16 | |
17 | { |
5ab06a4d |
18 | BEGIN { $ENV{PERL_STRICTURES_EXTRA} = 0 } |
eae006ee |
19 | use strictures 1; |
20 | BEGIN { capture_us } |
5ab06a4d |
21 | BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} } |
eae006ee |
22 | } |
23 | |
24 | { |
25 | use strict; |
26 | use warnings FATAL => 'all'; |
27 | BEGIN { capture_expect } |
28 | } |
29 | |
30 | # I'm assuming here we'll have more cases later. maybe not. eh. |
31 | |
32 | foreach my $idx (0 .. $#us) { |
33 | is($us[$idx][0], $expect[$idx][0], 'Hints ok for case '.($idx+1)); |
34 | is($us[$idx][1], $expect[$idx][1], 'Warnings ok for case '.($idx+1)); |
35 | } |
36 | |
084caaf3 |
37 | SKIP: { |
38 | skip 'Extra tests disabled on perls <= 5.008003', 1 |
39 | if $] < 5.008004; |
bc2262ba |
40 | skip 'Not got all the modules to do this', 1 |
41 | unless eval { |
42 | require indirect; |
43 | require multidimensional; |
44 | require bareword::filehandles; |
45 | 1; |
46 | }; |
eae006ee |
47 | sub Foo::new { 1 } |
98b2be98 |
48 | chdir("t/smells-of-vcs"); |
12b8f19b |
49 | local $strictures::Smells_Like_VCS = 1; |
e622821f |
50 | foreach my $file (qw(lib/one.pm t/one.faket)) { |
5ab06a4d |
51 | ok(!eval { require $file; 1 }, "Failed to load ${file}"); |
52 | like($@, qr{Indirect call of method}, "Failed due to indirect.pm, ok"); |
53 | } |
54 | ok(eval { require "other/one.pl"; 1 }, "Loaded other/one.pl ok"); |
a91e95ab |
55 | chdir("../.."); |
eae006ee |
56 | } |
57 | |
58 | ok(!eval q{use strictures 2; 1; }, "Can't use strictures 2 (this is version 1)"); |
a91e95ab |
59 | |
60 | { |
61 | skip 'Extra tests disabled on perls <= 5.008003', 1 |
62 | if $] < 5.008004; |
63 | local $ENV{PERL_STRICTURES_EXTRA} = 1; |
64 | local $strictures::extra_load_states = undef; |
65 | local @INC = ("t/dep_constellations/broken", @INC); |
66 | local %INC = %INC; |
67 | delete $INC{$_} |
68 | for qw( indirect.pm multidimensional.pm bareword/filehandles.pm ); |
69 | |
70 | { |
71 | open my $fh, '>', \my $str; |
72 | local *STDERR = $fh; |
73 | strictures->import; |
74 | like( |
75 | $str, |
76 | qr/Missing were:\n\n indirect multidimensional bareword::filehandles/, |
77 | "failure to load all three extra deps is reported" |
78 | ); |
79 | } |
80 | |
81 | { |
82 | open my $fh, '>', \my $str; |
83 | local *STDERR = $fh; |
84 | strictures->import; |
85 | ok( !$str, "extra dep load failure is not reported a second time" ); |
86 | } |
87 | } |