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 | |