vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/t/07_perlcritic.t

   1 #!perl
   2
   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) $
   6 #   $Author: clonezone $
   7 # $Revision: 2416 $
   8 ##############################################################################
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use File::Spec;
  14 use English qw(-no_match_vars);
  15 use Test::More tests => 36;
  16
  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')
  20
  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
  24
  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
  27 # without a prefix.
  28
  29 #-----------------------------------------------------------------------------
  30
  31 local @ARGV = ();
  32 my %options = ();
  33
  34 #-----------------------------------------------------------------------------
  35
  36 @ARGV = qw(-1 -2 -3 -4 -5);
  37 %options = get_options();
  38 is( $options{-severity}, 1);
  39
  40 @ARGV = qw(-5 -3 -4 -1 -2);
  41 %options = get_options();
  42 is( $options{-severity}, 1);
  43
  44 @ARGV = qw();
  45 %options = get_options();
  46 is( $options{-severity}, undef);
  47
  48 @ARGV = qw(-2 -3 -severity 4);
  49 %options = get_options();
  50 is( $options{-severity}, 4);
  51
  52 @ARGV = qw(-severity 2 -3 -4);
  53 %options = get_options();
  54 is( $options{-severity}, 2);
  55
  56 @ARGV = qw(--severity=2 -3 -4);
  57 %options = get_options();
  58 is( $options{-severity}, 2);
  59
  60 @ARGV = qw(-cruel);
  61 %options = get_options();
  62 is( $options{-severity}, 'cruel');
  63
  64 @ARGV = qw(-cruel --severity=1);
  65 %options = get_options();
  66 is( $options{-severity}, 1);
  67
  68 @ARGV = qw(-stern --severity=1 -2);
  69 %options = get_options();
  70 is( $options{-severity}, 1);
  71
  72 @ARGV = qw(-stern -severity 1 -2);
  73 %options = get_options();
  74 is( $options{-severity}, 1);
  75
  76 #-----------------------------------------------------------------------------
  77
  78 @ARGV = qw(-top);
  79 %options = get_options();
  80 is( $options{-severity}, 1);
  81 is( $options{-top}, 20);
  82
  83 @ARGV = qw(-top 10);
  84 %options = get_options();
  85 is( $options{-severity}, 1);
  86 is( $options{-top}, 10);
  87
  88 @ARGV = qw(-severity 4 -top);
  89 %options = get_options();
  90 is( $options{-severity}, 4);
  91 is( $options{-top}, 20);
  92
  93 @ARGV = qw(-severity 4 -top 10);
  94 %options = get_options();
  95 is( $options{-severity}, 4);
  96 is( $options{-top}, 10);
  97
  98 @ARGV = qw(-severity 5 -2 -top 5);
  99 %options = get_options();
 100 is( $options{-severity}, 5);
 101 is( $options{-top}, 5);
 102
 103 #-----------------------------------------------------------------------------
 104
 105 @ARGV = qw(-noprofile);
 106 %options = get_options();
 107 is( $options{-profile}, q{});
 108
 109 @ARGV = qw(-profile foo);
 110 %options = get_options();
 111 is( $options{-profile}, 'foo');
 112
 113 #-----------------------------------------------------------------------------
 114
 115 @ARGV = qw(-single-policy nowarnings);
 116 %options = get_options();
 117 is( $options{'-single-policy'}, 'nowarnings');
 118
 119 #-----------------------------------------------------------------------------
 120
 121 @ARGV = qw(-verbose 2);
 122 %options = get_options();
 123 is( $options{-verbose}, 2);
 124
 125 @ARGV = qw(-verbose %l:%c:%m);
 126 %options = get_options();
 127 is( $options{-verbose}, '%l:%c:%m');
 128
 129 #-----------------------------------------------------------------------------
 130
 131 @ARGV = qw(-statistics);
 132 %options = get_options();
 133 is( $options{-statistics}, 1);
 134
 135 #-----------------------------------------------------------------------------
 136
 137 @ARGV = qw(-statistics-only);
 138 %options = get_options();
 139 is( $options{'-statistics-only'}, 1);
 140
 141 #-----------------------------------------------------------------------------
 142
 143 @ARGV = qw(-quiet);
 144 %options = get_options();
 145 is( $options{-quiet}, 1);
 146
 147 #-----------------------------------------------------------------------------
 148 # Intercept pod2usage so we can test invalid options and special switches
 149
 150 {
 151     no warnings qw(redefine once);
 152     local *main::pod2usage = sub { my %args = @_; die $args{-message} || q{} };
 153
 154     eval { @ARGV = qw( -help ); get_options() };
 155     ok( $EVAL_ERROR, '-help option' );
 156
 157     eval { @ARGV = qw( -options ); get_options() };
 158     ok( $EVAL_ERROR, '-options option' );
 159
 160     eval { @ARGV = qw( -man ); get_options() };
 161     ok( $EVAL_ERROR, '-man option' );
 162
 163     eval { @ARGV = qw( -noprofile -profile foo ); get_options() };
 164     like( $EVAL_ERROR, qr/-noprofile with -profile/, '-noprofile with -profile');
 165
 166     eval { @ARGV = qw( -verbose bogus ); get_options() };
 167     like( $EVAL_ERROR, qr/looks odd/, 'Invalid -verbose option' );
 168
 169     eval { @ARGV = qw( -top -9 ); get_options() };
 170     like( $EVAL_ERROR, qr/is negative/, 'Negative -verbose option' );
 171
 172     eval { @ARGV = qw( -severity 0 ); get_options() };
 173     like( $EVAL_ERROR, qr/out of range/, '-severity too small' );
 174
 175     eval { @ARGV = qw( -severity 6 ); get_options() };
 176     like( $EVAL_ERROR, qr/out of range/, '-severity too large' );
 177 }
 178
 179 #-----------------------------------------------------------------------------
 180
 181 # ensure we run true if this test is loaded by
 182 # t/07_perlcritic.t_without_optional_dependencies.t
 183 1;
 184
 185 # Local Variables:
 186 #   mode: cperl
 187 #   cperl-indent-level: 4
 188 #   fill-column: 78
 189 #   indent-tabs-mode: nil
 190 #   c-indentation-style: bsd
 191 # End:
 192 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :