| Commit | Line | Data |
|---|
| a5d6e23b |
1 | #!perl |
| 2 | |
| 3 | ############################################################################## |
| 4 | # $URL: http://perlcritic.tigris.org/svn/perlcritic/branches/jeff/Perl-Critic-Dynamic/lib/Perl/Critic/Policy/Dynamic/ValidateAgainstSymbolTable.pm $ |
| 5 | # $Date: 2007-06-07 05:40:51 -0700 (Thu, 07 Jun 2007) $ |
| 6 | # $Author: thaljef $ |
| 7 | # $Revision: 1617 $ |
| 8 | ############################################################################## |
| 9 | |
| 10 | use strict; |
| 11 | use warnings; |
| 12 | use Test::More; |
| 13 | use English qw(-no_match_vars); |
| 14 | |
| 15 | # common P::C testing tools |
| 16 | use Perl::Critic::TestUtils qw(subtests_in_tree pcritique); |
| 17 | Perl::Critic::TestUtils::block_perlcriticrc(); |
| 18 | |
| 19 | #----------------------------------------------------------------------------- |
| 20 | |
| 21 | my $subtests = subtests_in_tree( 't' ); |
| 22 | |
| 23 | # Check for cmdline limit on policies. Example: |
| 24 | # perl -Ilib t/20_policies.t BuiltinFunctions::ProhibitLvalueSubstr |
| 25 | if (@ARGV) { |
| 26 | my @policies = keys %{$subtests}; |
| 27 | # This is inefficient, but who cares... |
| 28 | for my $p (@policies) { |
| 29 | if (0 == grep {$_ eq $p} @ARGV) { |
| 30 | delete $subtests->{$p}; |
| 31 | } |
| 32 | } |
| 33 | } |
| 34 | |
| 35 | #----------------------------------------------------------------------------- |
| 36 | |
| 37 | # count how many tests there will be |
| 38 | my $nsubtests = 0; |
| 39 | for my $s (values %$subtests) { |
| 40 | $nsubtests += @$s; # one [pf]critique() test per subtest |
| 41 | } |
| 42 | my $npolicies = scalar keys %$subtests; # one can() test per policy |
| 43 | |
| 44 | plan tests => $nsubtests + $npolicies; |
| 45 | |
| 46 | #----------------------------------------------------------------------------- |
| 47 | |
| 48 | for my $policy ( sort keys %$subtests ) { |
| 49 | |
| 50 | can_ok( "Perl::Critic::Policy::$policy", 'violates' ); |
| 51 | |
| 52 | for my $subtest ( @{$subtests->{$policy}} ) { |
| 53 | |
| 54 | local $TODO = $subtest->{TODO}; # Is NOT a TODO if it's not set |
| 55 | my ($line, $test_name) = ($subtest->{lineno}, $subtest->{name}); |
| 56 | my $desc = join(' - ', $policy, "line $line", $test_name); |
| 57 | |
| 58 | my $number_of_violations = |
| 59 | eval { pcritique($policy, \$subtest->{code}, $subtest->{parms}) }; |
| 60 | |
| 61 | if ($subtest->{error}) { |
| 62 | if ( 'Regexp' eq ref $subtest->{error} ) { |
| 63 | like($EVAL_ERROR, $subtest->{error}, $desc); |
| 64 | } |
| 65 | else { |
| 66 | ok($EVAL_ERROR, $desc); |
| 67 | } |
| 68 | } |
| 69 | else { |
| 4f05258e |
70 | die $EVAL_ERROR if $EVAL_ERROR; |
| a5d6e23b |
71 | is($number_of_violations, $subtest->{failures}, $desc); |
| 72 | } |
| 73 | } |
| 74 | } |
| 75 | |
| 76 | ############################################################################## |
| 77 | # Local Variables: |
| 78 | # mode: cperl |
| 79 | # cperl-indent-level: 4 |
| 80 | # fill-column: 78 |
| 81 | # indent-tabs-mode: nil |
| 82 | # c-indentation-style: bsd |
| 83 | # End: |
| 84 | # ex: set ts=8 sts=4 sw=4 tw=78 expandtab ft=perl: |
| 85 | |
projects / gitmo/Perl-Critic-Dynamic-Moose.git / blame