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 | |
91b5f6b6 |
37 | my $v; |
38 | eval { $v = strictures->VERSION; 1 } or diag $@; |
39 | is $v, $strictures::VERSION, '->VERSION returns version correctly'; |
40 | |
084caaf3 |
41 | SKIP: { |
42 | skip 'Extra tests disabled on perls <= 5.008003', 1 |
43 | if $] < 5.008004; |
bc2262ba |
44 | skip 'Not got all the modules to do this', 1 |
45 | unless eval { |
46 | require indirect; |
47 | require multidimensional; |
48 | require bareword::filehandles; |
49 | 1; |
50 | }; |
eae006ee |
51 | sub Foo::new { 1 } |
98b2be98 |
52 | chdir("t/smells-of-vcs"); |
12b8f19b |
53 | local $strictures::Smells_Like_VCS = 1; |
e622821f |
54 | foreach my $file (qw(lib/one.pm t/one.faket)) { |
5ab06a4d |
55 | ok(!eval { require $file; 1 }, "Failed to load ${file}"); |
56 | like($@, qr{Indirect call of method}, "Failed due to indirect.pm, ok"); |
57 | } |
58 | ok(eval { require "other/one.pl"; 1 }, "Loaded other/one.pl ok"); |
a91e95ab |
59 | chdir("../.."); |
eae006ee |
60 | } |
61 | |
62 | ok(!eval q{use strictures 2; 1; }, "Can't use strictures 2 (this is version 1)"); |
a91e95ab |
63 | |
bce2c903 |
64 | SKIP: { |
a91e95ab |
65 | skip 'Extra tests disabled on perls <= 5.008003', 1 |
66 | if $] < 5.008004; |
67 | local $ENV{PERL_STRICTURES_EXTRA} = 1; |
68 | local $strictures::extra_load_states = undef; |
69 | local @INC = ("t/dep_constellations/broken", @INC); |
70 | local %INC = %INC; |
71 | delete $INC{$_} |
72 | for qw( indirect.pm multidimensional.pm bareword/filehandles.pm ); |
73 | |
74 | { |
75 | open my $fh, '>', \my $str; |
76 | local *STDERR = $fh; |
77 | strictures->import; |
78 | like( |
79 | $str, |
80 | qr/Missing were:\n\n indirect multidimensional bareword::filehandles/, |
81 | "failure to load all three extra deps is reported" |
82 | ); |
83 | } |
84 | |
85 | { |
86 | open my $fh, '>', \my $str; |
87 | local *STDERR = $fh; |
88 | strictures->import; |
89 | ok( !$str, "extra dep load failure is not reported a second time" ); |
90 | } |
91 | } |