Login
"## no critic" ProhibitMultiplePackages in 02_policy.t.
[gknop/Perl-Critic.git] / t / 07_perlcritic.t
CommitLineData
faa35de4
JRT
1#!perl
2
6036a254 3##############################################################################
f5c96cb2
JRT
4# $URL$
5# $Date$
6# $Author$
7# $Revision$
6036a254 8##############################################################################
af1acfa2 9
df6dee2b 10use 5.006001;
af1acfa2
JRT
11use strict;
12use warnings;
b185fa17 13
4268e673 14use English qw(-no_match_vars);
b185fa17
ES
15
16use File::Spec;
17
738830ba 18use Test::More tests => 36;
af1acfa2
JRT
19
20#-----------------------------------------------------------------------------
b185fa17
ES
21
22our $VERSION = '1.088';
23
24#-----------------------------------------------------------------------------
25
55ae7242
JRT
26# Load perlcritic like a library so we can test its subroutines. If it is not
27# found in blib, then use the one in bin (for example, when using 'prove')
af1acfa2
JRT
28
29my $perlcritic = File::Spec->catfile( qw(blib script perlcritic) );
55ae7242 30$perlcritic = File::Spec->catfile( qw(bin perlcritic) ) if ! -e $perlcritic;
58a432c1 31require $perlcritic; ## no critic
af1acfa2 32
45acb16b 33# Because bin/perlcritic does not declare a package, it has functions
84e87307 34# in main, just like this test file, so we can use its functions
45acb16b
CD
35# without a prefix.
36
af1acfa2
JRT
37#-----------------------------------------------------------------------------
38
55ae7242
JRT
39local @ARGV = ();
40my %options = ();
41
42#-----------------------------------------------------------------------------
43
44@ARGV = qw(-1 -2 -3 -4 -5);
45%options = get_options();
af1acfa2
JRT
46is( $options{-severity}, 1);
47
55ae7242 48@ARGV = qw(-5 -3 -4 -1 -2);
af1acfa2
JRT
49%options = get_options();
50is( $options{-severity}, 1);
51
55ae7242 52@ARGV = qw();
af1acfa2
JRT
53%options = get_options();
54is( $options{-severity}, undef);
55
55ae7242 56@ARGV = qw(-2 -3 -severity 4);
af1acfa2 57%options = get_options();
55ae7242 58is( $options{-severity}, 4);
af1acfa2 59
55ae7242 60@ARGV = qw(-severity 2 -3 -4);
af1acfa2 61%options = get_options();
55ae7242 62is( $options{-severity}, 2);
af1acfa2 63
0bcb38c0
JRT
64@ARGV = qw(--severity=2 -3 -4);
65%options = get_options();
66is( $options{-severity}, 2);
67
68@ARGV = qw(-cruel);
69%options = get_options();
70is( $options{-severity}, 'cruel');
71
72@ARGV = qw(-cruel --severity=1);
73%options = get_options();
74is( $options{-severity}, 1);
75
76@ARGV = qw(-stern --severity=1 -2);
77%options = get_options();
78is( $options{-severity}, 1);
79
80@ARGV = qw(-stern -severity 1 -2);
81%options = get_options();
82is( $options{-severity}, 1);
83
af1acfa2
JRT
84#-----------------------------------------------------------------------------
85
55ae7242 86@ARGV = qw(-top);
af1acfa2
JRT
87%options = get_options();
88is( $options{-severity}, 1);
89is( $options{-top}, 20);
90
55ae7242 91@ARGV = qw(-top 10);
af1acfa2
JRT
92%options = get_options();
93is( $options{-severity}, 1);
94is( $options{-top}, 10);
95
55ae7242 96@ARGV = qw(-severity 4 -top);
af1acfa2
JRT
97%options = get_options();
98is( $options{-severity}, 4);
99is( $options{-top}, 20);
100
55ae7242 101@ARGV = qw(-severity 4 -top 10);
af1acfa2
JRT
102%options = get_options();
103is( $options{-severity}, 4);
104is( $options{-top}, 10);
105
55ae7242 106@ARGV = qw(-severity 5 -2 -top 5);
af1acfa2 107%options = get_options();
55ae7242 108is( $options{-severity}, 5);
af1acfa2
JRT
109is( $options{-top}, 5);
110
111#-----------------------------------------------------------------------------
112
55ae7242 113@ARGV = qw(-noprofile);
af1acfa2
JRT
114%options = get_options();
115is( $options{-profile}, q{});
116
55ae7242 117@ARGV = qw(-profile foo);
af1acfa2
JRT
118%options = get_options();
119is( $options{-profile}, 'foo');
120
121#-----------------------------------------------------------------------------
122
738830ba 123@ARGV = qw(-single-policy nowarnings);
585ddee1 124%options = get_options();
738830ba 125is( $options{'-single-policy'}, 'nowarnings');
585ddee1
ES
126
127#-----------------------------------------------------------------------------
128
55ae7242 129@ARGV = qw(-verbose 2);
af1acfa2
JRT
130%options = get_options();
131is( $options{-verbose}, 2);
132
55ae7242 133@ARGV = qw(-verbose %l:%c:%m);
af1acfa2
JRT
134%options = get_options();
135is( $options{-verbose}, '%l:%c:%m');
136
137#-----------------------------------------------------------------------------
138
738830ba
ES
139@ARGV = qw(-statistics);
140%options = get_options();
141is( $options{-statistics}, 1);
142
143#-----------------------------------------------------------------------------
144
145@ARGV = qw(-statistics-only);
146%options = get_options();
147is( $options{'-statistics-only'}, 1);
148
149#-----------------------------------------------------------------------------
150
8b5892fc
AL
151@ARGV = qw(-quiet);
152%options = get_options();
153is( $options{-quiet}, 1);
154
155#-----------------------------------------------------------------------------
4268e673
JRT
156# Intercept pod2usage so we can test invalid options and special switches
157
158{
159 no warnings qw(redefine once);
160 local *main::pod2usage = sub { my %args = @_; die $args{-message} || q{} };
161
162 eval { @ARGV = qw( -help ); get_options() };
163 ok( $EVAL_ERROR, '-help option' );
164
738830ba
ES
165 eval { @ARGV = qw( -options ); get_options() };
166 ok( $EVAL_ERROR, '-options option' );
167
4268e673
JRT
168 eval { @ARGV = qw( -man ); get_options() };
169 ok( $EVAL_ERROR, '-man option' );
170
171 eval { @ARGV = qw( -noprofile -profile foo ); get_options() };
e7ae8f62 172 like( $EVAL_ERROR, qr/-noprofile with -profile/, '-noprofile with -profile');
4268e673
JRT
173
174 eval { @ARGV = qw( -verbose bogus ); get_options() };
175 like( $EVAL_ERROR, qr/looks odd/, 'Invalid -verbose option' );
176
177 eval { @ARGV = qw( -top -9 ); get_options() };
178 like( $EVAL_ERROR, qr/is negative/, 'Negative -verbose option' );
179
180 eval { @ARGV = qw( -severity 0 ); get_options() };
181 like( $EVAL_ERROR, qr/out of range/, '-severity too small' );
182
183 eval { @ARGV = qw( -severity 6 ); get_options() };
184 like( $EVAL_ERROR, qr/out of range/, '-severity too large' );
185}
34cc6052 186
4268e673 187#-----------------------------------------------------------------------------
737d3b65 188
34cc6052
ES
189# ensure we run true if this test is loaded by
190# t/07_perlcritic.t_without_optional_dependencies.t
1911;
192
737d3b65
CD
193# Local Variables:
194# mode: cperl
195# cperl-indent-level: 4
196# fill-column: 78
197# indent-tabs-mode: nil
198# c-indentation-style: bsd
199# End:
96fed375 200# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :