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) $
8 ##############################################################################
13 use English qw(-no_match_vars);
15 # common P::C testing tools
16 use Perl::Critic::TestUtils qw(subtests_in_tree pcritique);
17 Perl::Critic::TestUtils::block_perlcriticrc();
19 #-----------------------------------------------------------------------------
21 my $subtests = subtests_in_tree( 't' );
23 # Check for cmdline limit on policies. Example:
24 # perl -Ilib t/20_policies.t BuiltinFunctions::ProhibitLvalueSubstr
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};
35 #-----------------------------------------------------------------------------
37 # count how many tests there will be
39 for my $s (values %$subtests) {
40 $nsubtests += @$s; # one [pf]critique() test per subtest
42 my $npolicies = scalar keys %$subtests; # one can() test per policy
44 plan tests => $nsubtests + $npolicies;
46 #-----------------------------------------------------------------------------
48 for my $policy ( sort keys %$subtests ) {
50 can_ok( "Perl::Critic::Policy::$policy", 'violates' );
52 for my $subtest ( @{$subtests->{$policy}} ) {
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);
58 my $number_of_violations =
59 eval { pcritique($policy, \$subtest->{code}, $subtest->{parms}) };
61 if ($subtest->{error}) {
62 if ( 'Regexp' eq ref $subtest->{error} ) {
63 like($EVAL_ERROR, $subtest->{error}, $desc);
66 ok($EVAL_ERROR, $desc);
70 die $EVAL_ERROR if $EVAL_ERROR;
71 is($number_of_violations, $subtest->{failures}, $desc);
76 ##############################################################################
79 # cperl-indent-level: 4
81 # indent-tabs-mode: nil
82 # c-indentation-style: bsd
84 # ex: set ts=8 sts=4 sw=4 tw=78 expandtab ft=perl: