git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/RegularExpressions/ProhibitUnusedCapture.run

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/RegularExpressions/ProhibitUnusedCapture.run $
   3 #     $Date: 2008-03-16 17:40:45 -0500 (Sun, 16 Mar 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2187 $
   6 ##############################################################################
   7
   8 ## name non-captures
   9 ## failures 0
  10 ## cut
  11
  12 m/foo/;
  13 m/(?:foo)/;
  14
  15 if (m/foo/) {
  16    print "bar";
  17 }
  18
  19 #-----------------------------------------------------------------------------
  20
  21 ## name assignment captures
  22 ## failures 0
  23 ## cut
  24
  25 my ($foo) = m/(foo)/;
  26 my ($foo) = m/(foo|bar)/;
  27 my ($foo) = m/(foo)(?:bar)/;
  28 my @foo = m/(foo)/;
  29 my @foo = m/(foo)/g;
  30 my %foo = m/(foo)(bar)/g;
  31
  32 my ($foo, $bar) = m/(foo)(bar)/;
  33 my @foo = m/(foo)(bar)/;
  34 my ($foo, @bar) = m/(foo)(bar)/;
  35 my ($foo, @bar) = m/(foo)(bar)(baz)/;
  36
  37 #-----------------------------------------------------------------------------
  38
  39 ## name undef array captures
  40 ## failures 0
  41 ## cut
  42
  43 () = m/(foo)/;
  44 (undef) = m/(foo)/;
  45 my ($foo) =()= m/(foo)/g;
  46
  47 #-----------------------------------------------------------------------------
  48
  49 ## name complex array assignment captures
  50 ## failures 0
  51 ## cut
  52
  53 @$foo = m/(foo)(bar)/;
  54 @{$foo} = m/(foo)(bar)/;
  55 %$foo = m/(foo)(bar)/;
  56 %{$foo} = m/(foo)(bar)/;
  57
  58 ($foo,@$foo) = m/(foo)(bar)/;
  59 ($foo,@{$foo}) = m/(foo)(bar)/;
  60
  61 #-----------------------------------------------------------------------------
  62
  63 ## name conditional captures
  64 ## failures 0
  65 ## cut
  66
  67 if (m/(foo)/) {
  68    my $foo = $1;
  69    print $foo;
  70 }
  71 if (m/(foo)(bar)/) {
  72    my $foo = $1;
  73    my $bar = $2;
  74    print $foo, $bar;
  75 }
  76 if (m/(foo)(bar)/) {
  77    my ($foo, $bar) = ($1, $2);
  78    print $foo, $bar;
  79 }
  80 if (m/(foo)(bar)/) {
  81    my (@foo) = ($1, $2);
  82    print @foo;
  83 }
  84
  85 if (m/(foo)/) {
  86    # bug, but not a violation of THIS policy
  87    my (@foo) = ($1, $2);
  88    print @foo;
  89 }
  90
  91 #-----------------------------------------------------------------------------
  92
  93 ## name boolean and ternary captures
  94 ## failures 0
  95 ## cut
  96
  97 m/(foo)/ && print $1;
  98 m/(foo)/ ? print $1 : die;
  99 m/(foo)/ && ($1 == 'foo') ? print 1 : die;
 100
 101 #-----------------------------------------------------------------------------
 102
 103 ## name loop captures
 104 ## failures 0
 105 ## cut
 106
 107 for (m/(foo)/) {
 108    my $foo = $1;
 109    print $foo;
 110 }
 111
 112 #-----------------------------------------------------------------------------
 113
 114 ## name slurpy array loop captures
 115 ## failures 0
 116 ## cut
 117
 118 map {print} m/(foo)/;
 119 foo(m/(foo)/);
 120 foo('bar', m/(foo)/);
 121 foo(m/(foo)/, 'bar');
 122 foo m/(foo)/;
 123 foo 'bar', m/(foo)/;
 124 foo m/(foo)/, 'bar';
 125
 126 ## name slurpy with assignment
 127 ## failures 0
 128 ## cut
 129
 130 my ($foo) = grep {$b++ == 2} m/(foo)/g;
 131 my ($foo) = grep {$b++ == 2} $str =~ m/(foo)/g;
 132
 133 #-----------------------------------------------------------------------------
 134
 135 ## name slurpy with array assignment
 136 ## failures 0
 137 ## cut
 138
 139 my @foo = grep {$b++ > 2} m/(foo)/g;
 140 my @foo = grep {$b++ > 2} $str =~ m/(foo)/g;
 141
 142 #-----------------------------------------------------------------------------
 143
 144 ## name assignment captures on string
 145 ## failures 0
 146 ## cut
 147
 148 my ($foo) = $str =~ m/(foo)/;
 149 my ($foo) = $str =~ m/(foo|bar)/;
 150 my ($foo) = $str =~ m/(foo)(?:bar)/;
 151 my @foo = $str =~ m/(foo)/;
 152 my @foo = $str =~ m/(foo)/g;
 153
 154 my ($foo, $bar) = $str =~ m/(foo)(bar)/;
 155 my @foo = $str =~ m/(foo)(bar)/;
 156 my ($foo, @bar) = $str =~ m/(foo)(bar)/;
 157 my (@bar) = $str =~ m/(foo)(bar)/;
 158 my ($foo, @bar) = $str =~ m/(foo)(bar)(baz)/;
 159
 160 #-----------------------------------------------------------------------------
 161
 162 ## name slurpy captures on string
 163 ## failures 0
 164 ## cut
 165
 166 map {print} $str =~ m/(foo)/g;
 167
 168 #-----------------------------------------------------------------------------
 169
 170 ## name self captures
 171 ## failures 0
 172 ## cut
 173
 174 m/(foo)\1/;
 175 s/(foo)/$1/;
 176
 177 #-----------------------------------------------------------------------------
 178
 179 ## name basic failures
 180 ## failures 5
 181 ## optional_modules Regexp::Parser
 182 ## cut
 183
 184 m/(foo)/;
 185 my ($foo) = m/(foo)/g;
 186
 187 if (m/(foo)/) {
 188    print "bar";
 189 }
 190 if (m/(foo)(bar)/) {
 191    my $foo = $1;
 192    print $foo;
 193 }
 194
 195 for (m/(foo)/) {
 196    print "bar";
 197 }
 198
 199 #-----------------------------------------------------------------------------
 200
 201 ## name negated regexp failures
 202 ## failures 1
 203 ## optional_modules Regexp::Parser
 204 ## cut
 205
 206 my ($foo) = $str !~ m/(foo)/;
 207
 208 #-----------------------------------------------------------------------------
 209
 210 ## name statement failures
 211 ## failures 1
 212 ## optional_modules Regexp::Parser
 213 ## cut
 214
 215 m/(foo)/ && m/(bar)/ && print $1;
 216
 217 #-----------------------------------------------------------------------------
 218
 219 ## name sub failures
 220 ## failures 1
 221 ## optional_modules Regexp::Parser
 222 ## cut
 223
 224 sub foo {
 225   m/(foo)/;
 226   return;
 227 }
 228 print $1;
 229
 230 #-----------------------------------------------------------------------------
 231
 232 ## name anon sub failures
 233 ## failures 1
 234 ## optional_modules Regexp::Parser
 235 ## TODO PPI v1.118 doesn't recognize anonymous subroutines
 236 ## cut
 237
 238 my $sub = sub foo {
 239   m/(foo)/;
 240   return;
 241 };
 242 print $1;
 243
 244 #-----------------------------------------------------------------------------
 245
 246 ## name ref constructors
 247 ## failures 0
 248 ## cut
 249
 250 $f = { m/(\w+)=(\w+)/g };
 251 $f = [ m/(\w+)/g ];
 252
 253 #-----------------------------------------------------------------------------
 254
 255 ## name sub returns
 256 ## failures 0
 257 ## cut
 258
 259 sub foo {
 260    m/(foo)/;
 261 }
 262 sub foo {
 263    return m/(foo)/;
 264 }
 265 map { m/(foo)/ } (1, 2, 3);
 266
 267 #-----------------------------------------------------------------------------
 268
 269 ## name failing regexp with syntax error
 270 ## failures 0
 271 ## cut
 272
 273 m/(foo)(/;
 274
 275 #-----------------------------------------------------------------------------
 276
 277 ## name lvalue sub assigment pass
 278 ## failures 0
 279 ## cut
 280
 281 (substr $str, 0, 1) = m/(\w+)/;
 282
 283 #-----------------------------------------------------------------------------
 284
 285 ## name lvalue sub assigment failure
 286 ## failures 1
 287 ## optional_modules Regexp::Parser
 288 ## TODO lvalue subs are too complex to support
 289 ## cut
 290
 291 (substr $str, 0, 1) = m/(\w+)(\d+)/;
 292
 293 #-----------------------------------------------------------------------------
 294
 295 ## name code coverage
 296 ## failures 1
 297 ## optional_modules Regexp::Parser
 298 ## cut
 299
 300 m/(foo)/;
 301 print $0;
 302 print @ARGV;
 303 print $_;
 304
 305 #-----------------------------------------------------------------------------
 306
 307 # Local Variables:
 308 #   mode: cperl
 309 #   cperl-indent-level: 4
 310 #   fill-column: 78
 311 #   indent-tabs-mode: nil
 312 #   c-indentation-style: bsd
 313 # End:
 314 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :