Login
Apply the unmodified patch from Schwern (modulo dealing with
[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);
f9a8aec7 15use Carp qw< confess >;
b185fa17
ES
16
17use File::Spec;
18
3ddf1d63
ES
19use Perl::Critic::Utils qw< :characters >;
20
89b50090 21use Test::More tests => 37;
af1acfa2
JRT
22
23#-----------------------------------------------------------------------------
b185fa17 24
be4331b3 25our $VERSION = '1.090';
b185fa17
ES
26
27#-----------------------------------------------------------------------------
28
55ae7242
JRT
29# Load perlcritic like a library so we can test its subroutines. If it is not
30# found in blib, then use the one in bin (for example, when using 'prove')
af1acfa2
JRT
31
32my $perlcritic = File::Spec->catfile( qw(blib script perlcritic) );
649a132b
ES
33if (not -e $perlcritic) {
34 $perlcritic = File::Spec->catfile( qw(bin perlcritic) )
35}
58a432c1 36require $perlcritic; ## no critic
af1acfa2 37
45acb16b 38# Because bin/perlcritic does not declare a package, it has functions
84e87307 39# in main, just like this test file, so we can use its functions
45acb16b
CD
40# without a prefix.
41
af1acfa2
JRT
42#-----------------------------------------------------------------------------
43
55ae7242 44local @ARGV = ();
3ddf1d63 45my $message;
55ae7242
JRT
46my %options = ();
47
48#-----------------------------------------------------------------------------
49
fad26b48 50local @ARGV = qw(-1 -2 -3 -4 -5);
3ddf1d63 51$message = "@ARGV";
55ae7242 52%options = get_options();
3ddf1d63 53is( $options{-severity}, 1, $message);
af1acfa2 54
fad26b48 55local @ARGV = qw(-5 -3 -4 -1 -2);
3ddf1d63 56$message = "@ARGV";
af1acfa2 57%options = get_options();
3ddf1d63 58is( $options{-severity}, 1, $message);
af1acfa2 59
fad26b48 60local @ARGV = qw();
af1acfa2 61%options = get_options();
3ddf1d63 62is( $options{-severity}, undef, 'no arguments');
af1acfa2 63
fad26b48 64local @ARGV = qw(-2 -3 -severity 4);
3ddf1d63 65$message = "@ARGV";
af1acfa2 66%options = get_options();
3ddf1d63 67is( $options{-severity}, 4, $message);
af1acfa2 68
fad26b48 69local @ARGV = qw(-severity 2 -3 -4);
3ddf1d63 70$message = "@ARGV";
af1acfa2 71%options = get_options();
3ddf1d63 72is( $options{-severity}, 2, $message);
af1acfa2 73
fad26b48 74local @ARGV = qw(--severity=2 -3 -4);
3ddf1d63 75$message = "@ARGV";
0bcb38c0 76%options = get_options();
3ddf1d63 77is( $options{-severity}, 2, $message);
0bcb38c0 78
fad26b48 79local @ARGV = qw(-cruel);
3ddf1d63 80$message = "@ARGV";
0bcb38c0 81%options = get_options();
3ddf1d63 82is( $options{-severity}, 'cruel', $message);
0bcb38c0 83
3ddf1d63
ES
84local @ARGV = qw(-cruel --severity=1 );
85$message = "@ARGV";
0bcb38c0 86%options = get_options();
3ddf1d63 87is( $options{-severity}, 1, $message);
0bcb38c0 88
fad26b48 89local @ARGV = qw(-stern --severity=1 -2);
3ddf1d63 90$message = "@ARGV";
0bcb38c0 91%options = get_options();
3ddf1d63 92is( $options{-severity}, 1, $message);
0bcb38c0 93
fad26b48 94local @ARGV = qw(-stern -severity 1 -2);
3ddf1d63 95$message = "@ARGV";
0bcb38c0 96%options = get_options();
3ddf1d63 97is( $options{-severity}, 1, $message);
0bcb38c0 98
af1acfa2
JRT
99#-----------------------------------------------------------------------------
100
fad26b48 101local @ARGV = qw(-top);
3ddf1d63 102$message = "@ARGV";
af1acfa2 103%options = get_options();
3ddf1d63
ES
104is( $options{-severity}, 1, $message);
105is( $options{-top}, 20, $message);
af1acfa2 106
fad26b48 107local @ARGV = qw(-top 10);
3ddf1d63 108$message = "@ARGV";
af1acfa2 109%options = get_options();
3ddf1d63
ES
110is( $options{-severity}, 1, $message);
111is( $options{-top}, 10, $message);
af1acfa2 112
fad26b48 113local @ARGV = qw(-severity 4 -top);
3ddf1d63 114$message = "@ARGV";
af1acfa2 115%options = get_options();
3ddf1d63
ES
116is( $options{-severity}, 4, $message);
117is( $options{-top}, 20, $message);
af1acfa2 118
fad26b48 119local @ARGV = qw(-severity 4 -top 10);
3ddf1d63 120$message = "@ARGV";
af1acfa2 121%options = get_options();
3ddf1d63
ES
122is( $options{-severity}, 4, $message);
123is( $options{-top}, 10, $message);
af1acfa2 124
fad26b48 125local @ARGV = qw(-severity 5 -2 -top 5);
3ddf1d63 126$message = "@ARGV";
af1acfa2 127%options = get_options();
3ddf1d63
ES
128is( $options{-severity}, 5, $message);
129is( $options{-top}, 5, $message);
af1acfa2
JRT
130
131#-----------------------------------------------------------------------------
132
fad26b48 133local @ARGV = qw(-noprofile);
3ddf1d63 134$message = "@ARGV";
af1acfa2 135%options = get_options();
3ddf1d63 136is( $options{-profile}, q{}, $message);
af1acfa2 137
fad26b48 138local @ARGV = qw(-profile foo);
3ddf1d63 139$message = "@ARGV";
af1acfa2 140%options = get_options();
3ddf1d63 141is( $options{-profile}, 'foo', $message);
af1acfa2
JRT
142
143#-----------------------------------------------------------------------------
144
fad26b48 145local @ARGV = qw(-single-policy nowarnings);
3ddf1d63 146$message = "@ARGV";
585ddee1 147%options = get_options();
3ddf1d63 148is( $options{'-single-policy'}, 'nowarnings', $message);
585ddee1
ES
149
150#-----------------------------------------------------------------------------
151
fad26b48 152local @ARGV = qw(-verbose 2);
3ddf1d63 153$message = "@ARGV";
af1acfa2 154%options = get_options();
3ddf1d63 155is( $options{-verbose}, 2, $message);
af1acfa2 156
fad26b48 157local @ARGV = qw(-verbose %l:%c:%m);
af1acfa2 158%options = get_options();
3ddf1d63 159is( $options{-verbose}, '%l:%c:%m', $message);
af1acfa2
JRT
160
161#-----------------------------------------------------------------------------
162
fad26b48 163local @ARGV = qw(-statistics);
3ddf1d63 164$message = "@ARGV";
738830ba 165%options = get_options();
3ddf1d63 166is( $options{-statistics}, 1, $message);
738830ba
ES
167
168#-----------------------------------------------------------------------------
169
fad26b48 170local @ARGV = qw(-statistics-only);
3ddf1d63 171$message = "@ARGV";
738830ba 172%options = get_options();
3ddf1d63 173is( $options{'-statistics-only'}, 1, $message);
738830ba
ES
174
175#-----------------------------------------------------------------------------
176
fad26b48 177local @ARGV = qw(-quiet);
3ddf1d63 178$message = "@ARGV";
8b5892fc 179%options = get_options();
3ddf1d63 180is( $options{-quiet}, 1, $message);
8b5892fc 181
89b50090
ES
182
183#-----------------------------------------------------------------------------
184
185local @ARGV = qw(-pager foo);
186%options = eval { get_options() };
187is( $options{-pager}, "foo", "@ARGV" );
188
189
8b5892fc 190#-----------------------------------------------------------------------------
4268e673
JRT
191# Intercept pod2usage so we can test invalid options and special switches
192
193{
5c1b319c 194 no warnings qw(redefine once); ## no critic (ProhibitNoWarnings)
f9a8aec7 195 local *main::pod2usage = sub { my %args = @_; confess $args{-message} || q{} };
4268e673 196
fad26b48
ES
197 local @ARGV = qw( -help );
198 eval { get_options() };
4268e673
JRT
199 ok( $EVAL_ERROR, '-help option' );
200
fad26b48
ES
201 local @ARGV = qw( -options );
202 eval { get_options() };
738830ba
ES
203 ok( $EVAL_ERROR, '-options option' );
204
fad26b48
ES
205 local @ARGV = qw( -man );
206 eval { get_options() };
4268e673
JRT
207 ok( $EVAL_ERROR, '-man option' );
208
fad26b48
ES
209 local @ARGV = qw( -noprofile -profile foo );
210 eval { get_options() };
369d6f3a
ES
211 like(
212 $EVAL_ERROR,
213 qr/-noprofile [ ] with [ ] -profile/xms,
214 '-noprofile with -profile',
215 );
4268e673 216
fad26b48
ES
217 local @ARGV = qw( -verbose bogus );
218 eval { get_options() };
369d6f3a
ES
219 like(
220 $EVAL_ERROR,
221 qr/looks [ ] odd/xms,
222 'Invalid -verbose option',
223 );
4268e673 224
fad26b48
ES
225 local @ARGV = qw( -top -9 );
226 eval { get_options() };
369d6f3a
ES
227 like(
228 $EVAL_ERROR,
229 qr/is [ ] negative/xms,
230 'Negative -verbose option',
231 );
4268e673 232
fad26b48
ES
233 local @ARGV = qw( -severity 0 );
234 eval { get_options() };
369d6f3a
ES
235 like(
236 $EVAL_ERROR,
237 qr/out [ ] of [ ] range/xms,
238 '-severity too small',
239 );
4268e673 240
fad26b48
ES
241 local @ARGV = qw( -severity 6 );
242 eval { get_options() };
369d6f3a
ES
243 like(
244 $EVAL_ERROR,
245 qr/out [ ] of [ ] range/xms,
246 '-severity too large',
247 );
4268e673 248}
34cc6052 249
4268e673 250#-----------------------------------------------------------------------------
737d3b65 251
34cc6052
ES
252# ensure we run true if this test is loaded by
253# t/07_perlcritic.t_without_optional_dependencies.t
2541;
255
737d3b65
CD
256# Local Variables:
257# mode: cperl
258# cperl-indent-level: 4
259# fill-column: 78
260# indent-tabs-mode: nil
261# c-indentation-style: bsd
262# End:
96fed375 263# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :