3 ##############################################################################
4 # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/07_perlcritic.t $
5 # $Date: 2008-06-06 00:48:04 -0500 (Fri, 06 Jun 2008) $
8 ##############################################################################
14 use English qw(-no_match_vars);
15 use Test::More tests => 36;
17 #-----------------------------------------------------------------------------
18 # Load perlcritic like a library so we can test its subroutines. If it is not
19 # found in blib, then use the one in bin (for example, when using 'prove')
21 my $perlcritic = File::Spec->catfile( qw(blib script perlcritic) );
22 $perlcritic = File::Spec->catfile( qw(bin perlcritic) ) if ! -e $perlcritic;
23 require $perlcritic; ## no critic
25 # Because bin/perlcritic does not declare a package, it has functions
26 # in main, just like this test file, so we can use its functions
29 #-----------------------------------------------------------------------------
34 #-----------------------------------------------------------------------------
36 @ARGV = qw(-1 -2 -3 -4 -5);
37 %options = get_options();
38 is( $options{-severity}, 1);
40 @ARGV = qw(-5 -3 -4 -1 -2);
41 %options = get_options();
42 is( $options{-severity}, 1);
45 %options = get_options();
46 is( $options{-severity}, undef);
48 @ARGV = qw(-2 -3 -severity 4);
49 %options = get_options();
50 is( $options{-severity}, 4);
52 @ARGV = qw(-severity 2 -3 -4);
53 %options = get_options();
54 is( $options{-severity}, 2);
56 @ARGV = qw(--severity=2 -3 -4);
57 %options = get_options();
58 is( $options{-severity}, 2);
61 %options = get_options();
62 is( $options{-severity}, 'cruel');
64 @ARGV = qw(-cruel --severity=1);
65 %options = get_options();
66 is( $options{-severity}, 1);
68 @ARGV = qw(-stern --severity=1 -2);
69 %options = get_options();
70 is( $options{-severity}, 1);
72 @ARGV = qw(-stern -severity 1 -2);
73 %options = get_options();
74 is( $options{-severity}, 1);
76 #-----------------------------------------------------------------------------
79 %options = get_options();
80 is( $options{-severity}, 1);
81 is( $options{-top}, 20);
84 %options = get_options();
85 is( $options{-severity}, 1);
86 is( $options{-top}, 10);
88 @ARGV = qw(-severity 4 -top);
89 %options = get_options();
90 is( $options{-severity}, 4);
91 is( $options{-top}, 20);
93 @ARGV = qw(-severity 4 -top 10);
94 %options = get_options();
95 is( $options{-severity}, 4);
96 is( $options{-top}, 10);
98 @ARGV = qw(-severity 5 -2 -top 5);
99 %options = get_options();
100 is( $options{-severity}, 5);
101 is( $options{-top}, 5);
103 #-----------------------------------------------------------------------------
105 @ARGV = qw(-noprofile);
106 %options = get_options();
107 is( $options{-profile}, q{});
109 @ARGV = qw(-profile foo);
110 %options = get_options();
111 is( $options{-profile}, 'foo');
113 #-----------------------------------------------------------------------------
115 @ARGV = qw(-single-policy nowarnings);
116 %options = get_options();
117 is( $options{'-single-policy'}, 'nowarnings');
119 #-----------------------------------------------------------------------------
121 @ARGV = qw(-verbose 2);
122 %options = get_options();
123 is( $options{-verbose}, 2);
125 @ARGV = qw(-verbose %l:%c:%m);
126 %options = get_options();
127 is( $options{-verbose}, '%l:%c:%m');
129 #-----------------------------------------------------------------------------
131 @ARGV = qw(-statistics);
132 %options = get_options();
133 is( $options{-statistics}, 1);
135 #-----------------------------------------------------------------------------
137 @ARGV = qw(-statistics-only);
138 %options = get_options();
139 is( $options{'-statistics-only'}, 1);
141 #-----------------------------------------------------------------------------
144 %options = get_options();
145 is( $options{-quiet}, 1);
147 #-----------------------------------------------------------------------------
148 # Intercept pod2usage so we can test invalid options and special switches
151 no warnings qw(redefine once);
152 local *main::pod2usage = sub { my %args = @_; die $args{-message} || q{} };
154 eval { @ARGV = qw( -help ); get_options() };
155 ok( $EVAL_ERROR, '-help option' );
157 eval { @ARGV = qw( -options ); get_options() };
158 ok( $EVAL_ERROR, '-options option' );
160 eval { @ARGV = qw( -man ); get_options() };
161 ok( $EVAL_ERROR, '-man option' );
163 eval { @ARGV = qw( -noprofile -profile foo ); get_options() };
164 like( $EVAL_ERROR, qr/-noprofile with -profile/, '-noprofile with -profile');
166 eval { @ARGV = qw( -verbose bogus ); get_options() };
167 like( $EVAL_ERROR, qr/looks odd/, 'Invalid -verbose option' );
169 eval { @ARGV = qw( -top -9 ); get_options() };
170 like( $EVAL_ERROR, qr/is negative/, 'Negative -verbose option' );
172 eval { @ARGV = qw( -severity 0 ); get_options() };
173 like( $EVAL_ERROR, qr/out of range/, '-severity too small' );
175 eval { @ARGV = qw( -severity 6 ); get_options() };
176 like( $EVAL_ERROR, qr/out of range/, '-severity too large' );
179 #-----------------------------------------------------------------------------
181 # ensure we run true if this test is loaded by
182 # t/07_perlcritic.t_without_optional_dependencies.t
187 # cperl-indent-level: 4
189 # indent-tabs-mode: nil
190 # c-indentation-style: bsd
192 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :