git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/Variables/RequireLocalizedPunctuationVars.run.PL

   1 #!perl
   2 ##############################################################################
   3 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/Variables/RequireLocalizedPunctuationVars.run.PL $
   4 #     $Date: 2008-06-06 00:48:04 -0500 (Fri, 06 Jun 2008) $
   5 #   $Author: clonezone $
   6 # $Revision: 2416 $
   7 ##############################################################################
   8
   9 use 5.006001;
  10 use strict;
  11 use warnings;
  12
  13 use English qw(-no_match_vars);
  14 use Carp qw(confess);
  15
  16 use B::Keywords qw();
  17 use List::MoreUtils qw< apply uniq >;
  18
  19 my $this_program = __FILE__;
  20 (my $test_file_name = $this_program) =~ s/ \.PL \z //xms;
  21 if ($this_program eq $test_file_name) {
  22     confess
  23         'Was not able to figure out the name of the file to generate.'
  24         . "This program: $this_program.";
  25 }
  26
  27 print "\n\nGenerating $test_file_name.\n";
  28
  29
  30
  31 open my $test_file, '>', $test_file_name
  32     or die "Could not open $test_file_name: $ERRNO";
  33
  34 my @globals = (
  35     @B::Keywords::Arrays,
  36     @B::Keywords::Hashes,
  37     @B::Keywords::Scalars,
  38 );
  39 push @globals, uniq apply { s/ \A ([^*]) /*$1/xms } @B::Keywords::Filehandles;
  40 my %exceptions = map {$_ => 1} qw(
  41     $_
  42     $ARG
  43     @_
  44 );
  45
  46 my $carat_re = qr/\A [\$%]\^\w+ /xms;
  47
  48 my $numvars = @globals - keys %exceptions;
  49 my $numcarats = grep {!$exceptions{$_} && m/ $carat_re /xms} @globals;
  50
  51 print {$test_file} <<'EOF';
  52
  53 ## name Named magic variables, special case passes
  54 ## failures 0
  55 ## cut
  56
  57 local ($_, $RS) = ();
  58 local $SIG{__DIE__} = sub { print "AAAAAAARRRRRGGGGHHHHH....\n"; };
  59 $_ = 1;
  60 $ARG = 1;
  61 @_ = (1, 2, 3);
  62
  63 #-----------------------------------------------------------------------------
  64
  65 ## name Named magic variables, special case failures
  66 ## failures 1
  67 ## TODO we are not handling dereferences yet...
  68 ## cut
  69
  70 $SIG{__DIE__} = sub { print "AAAAAAARRRRRGGGGHHHHH....\n"; };
  71
  72 #-----------------------------------------------------------------------------
  73
  74 ## name Named magic variables, pass local
  75 ## failures 0
  76 ## cut
  77
  78 EOF
  79
  80 for my $varname (@globals) {
  81     print {$test_file} "local $varname = ();\n";
  82 }
  83
  84 print {$test_file} <<"EOF";
  85
  86 #-----------------------------------------------------------------------------
  87
  88 ## name Named magic variables, pass local()
  89 ## failures 0
  90 ## cut
  91
  92 EOF
  93
  94 for my $varname (@globals) {
  95     print {$test_file} "local ($varname) = ();\n";
  96 }
  97
  98 print {$test_file} <<"EOF";
  99
 100 #-----------------------------------------------------------------------------
 101
 102 ## name Named magic variables, pass (local)
 103 ## failures 0
 104 ## cut
 105
 106 EOF
 107
 108 for my $varname (@globals) {
 109     print {$test_file} "(local $varname) = ();\n";
 110 }
 111
 112 print {$test_file} <<"EOF";
 113
 114 #-----------------------------------------------------------------------------
 115
 116 ## name Named magic variables, pass = (local) =
 117 ## failures 0
 118 ## cut
 119
 120 EOF
 121
 122 for my $varname (@globals) {
 123     print {$test_file} "\@foo = (local $varname) = ();\n";
 124 }
 125
 126 print {$test_file} <<"EOF";
 127
 128 #-----------------------------------------------------------------------------
 129
 130 ## name Named magic variables, fail non-local, non-carats
 131 ## failures @{[$numvars - $numcarats]}
 132 ## cut
 133
 134 EOF
 135
 136 for my $varname (@globals) {
 137     next if $exceptions{$varname};
 138     next if $varname =~ m/ $carat_re /xms;
 139     print {$test_file} "$varname = ();\n";
 140 }
 141
 142 print {$test_file} <<"EOF";
 143
 144 #-----------------------------------------------------------------------------
 145
 146 ## name Named magic variables, fail non-local, carats
 147 ## failures $numcarats
 148 ## cut
 149
 150 EOF
 151
 152 for my $varname (@globals) {
 153     next if $exceptions{$varname};
 154     next if $varname !~ m/ $carat_re /xms;
 155     print {$test_file} "$varname = ();\n";
 156 }
 157
 158 print {$test_file} <<"EOF";
 159
 160 #-----------------------------------------------------------------------------
 161
 162 ## name Named magic variables, fail non-local, carats, no space
 163 ## failures $numcarats
 164 ## cut
 165
 166 EOF
 167
 168 for my $varname (@globals) {
 169     next if $exceptions{$varname};
 170     next if $varname !~ m/ $carat_re /xms;
 171     print {$test_file} "$varname= ();\n";
 172 }
 173
 174 print {$test_file} <<"EOF";
 175
 176 #-----------------------------------------------------------------------------
 177
 178 ## name Named magic variables, fail = (non-local) =
 179 ## failures $numvars
 180 ## cut
 181
 182 EOF
 183
 184 for my $varname (@globals) {
 185     next if $exceptions{$varname};
 186     print {$test_file} "\@foo = ($varname) = ();\n";
 187 }
 188
 189 print {$test_file} <<"EOF";
 190
 191 #-----------------------------------------------------------------------------
 192
 193 ## name Named magic variables, fail (non-local)
 194 ## failures $numvars
 195 ## cut
 196
 197 EOF
 198
 199 for my $varname (@globals) {
 200     next if $exceptions{$varname};
 201     print {$test_file} "($varname) = ();\n";
 202 }
 203
 204
 205 print {$test_file} <<'EOF';
 206
 207 #-----------------------------------------------------------------------------
 208
 209 ## name Allow "my" as well, RT #33937
 210 ## failures 0
 211 ## cut
 212
 213 for my $entry (
 214    sort {
 215        my @a = split m{,}xms, $a;
 216        my @b = split m{,}xms, $b;
 217        $a[0] cmp $b[0] || $a[1] <=> $b[1]
 218    } qw( b,6 c,3 )
 219    )
 220 {
 221    print;
 222 }
 223
 224 #-----------------------------------------------------------------------------
 225
 226 ##############################################################################
 227 #      $\URL$
 228 #     $\Date$
 229 #   $\Author$
 230 # $\Revision$
 231 ##############################################################################
 232
 233 # Local Variables:
 234 #   mode: cperl
 235 #   cperl-indent-level: 4
 236 #   fill-column: 78
 237 #   indent-tabs-mode: nil
 238 #   c-indentation-style: bsd
 239 # End:
 240 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
 241 EOF
 242
 243 close $test_file;
 244 print "Done.\n\n";