xt/warnings.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4
   5 BEGIN {
   6   plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006;
   7 }
   8
   9 BEGIN {
  10   eval 'use Test::Strict 0.05; 1'
  11     or plan skip_all => 'Test::Strict 0.05 not installed';
  12 }
  13
  14 use File::Find;
  15 use File::Basename;
  16
  17 ## I hope this can go away if Test::Strict or File::Find::Rule
  18 ## finally run under -T. Until then, I'm on my own here. ;-)
  19 my @files;
  20 my %trusted = (
  21   'NotReallyAClass.pm' => 1
  22 );
  23
  24 find({
  25   wanted => \&wanted,
  26   untaint => 1,
  27   untaint_pattern => qr|^([-+@\w./]+)$|,
  28   untaint_skip => 1,
  29   no_chdir => 1
  30 }, qw(lib t));
  31
  32 sub wanted {
  33   my $name = $File::Find::name;
  34   my $file = fileparse($name);
  35
  36   return if $name =~ /TestApp/;
  37
  38   if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) {
  39     push @files, $name;
  40   };
  41 };
  42
  43 if (scalar @files) {
  44   plan tests => scalar @files;
  45 } else {
  46   plan tests => 1;
  47   fail 'No perl files found for Test::Strict checks!';
  48 };
  49
  50 foreach (@files) {
  51    warnings_ok($_);
  52 }