Attached find a first pass at converting our perlcritic.t into using 
Test::Perl::Critic.

This patch:

- requires Test::Perl::Critic to do anything useful with the test. (We can add 
it to 
Bundle::Parrot)
- creates a new perlcritic.conf file that represents declaratively a large 
chunk of the code we 
used to use to manage the policy list.
- removes the ability to list the policies. (you have the conf file)
- removes the ability to specify a specific policy (you can roll your own with 
themes)
- removes the ability to specify a directory to run the policies against (but 
if we do, let's do it 
without File::Find, and just key off the MANIFEST like we do now.)
- keeps the ability to specify a "group" of tests, but calls it a theme, 
following the lead set by 
Perl::Critic.
- reports each file as a test, not each policy.

I think the last item there is a big reason we started down the path we did, 
but given how 
much simpler this script is, I don't think it's worth worrying about.

I've tested this on Perl::Critic 1.086; I'd be interested to hear feedback on 
older versions of 
P::C before I apply. (The old version I had installed is no longer available 
for easy download 
on the CPAN)

Feedback in general, as well: This is a reduction in features from the original 
version, but I 
think it's a step forward.

-- 
Will "Coke" Coleda
Index: tools/util/perlcritic.conf
===================================================================
--- tools/util/perlcritic.conf  (revision 0)
+++ tools/util/perlcritic.conf  (revision 0)
@@ -0,0 +1,65 @@
+verbose = 3
+
+[BuiltinFunctions::ProhibitStringySplit]
+add_themes = parrot
+
+[CodeLayout::ProhibitDuplicateCoda]
+add_themes = parrot
+
+[CodeLayout::ProhibitHardTabs]
+allow_leading_tabs = 0
+add_themes = parrot
+
+[CodeLayout::ProhibitTrailingWhitespace]
+add_themes = parrot
+
+[CodeLayout::RequireTidyCode]
+perltidyrc = tools/util/perltidy.conf
+add_themes = extra
+
+[CodeLayout::UseParrotCoda]
+add_themes = parrot
+
+[InputOutput::ProhibitBarewordFileHandles]
+add_themes = parrot
+
+[InputOutput::ProhibitTwoArgOpen]
+add_themes = parrot
+
+[NamingConventions::ProhibitAmbiguousNames]
+# remove abstract from the list of forbidden names
+forbid = bases close contract last left no record right second set
+add_themes = extra
+
+[Subroutines::ProhibitBuiltinHomonyms]
+add_themes = extra
+
+[Subroutines::ProhibitExplicitReturnUndef]
+add_themes = parrot
+
+[Subroutines::ProhibitSubroutinePrototypes]
+add_themes = parrot
+
+[Subroutines::RequireFinalReturn]
+add_themes = extra
+
+[TestingAndDebugging::MisplacedShebang]
+add_themes = parrot
+
+[TestingAndDebugging::ProhibitShebangWarningsArg]
+add_themes = parrot
+
+[TestingAndDebugging::RequirePortableShebang]
+add_themes = parrot
+
+[TestingAndDebugging::RequireUseStrict]
+add_themes = parrot
+
+[TestingAndDebugging::RequireUseWarnings]
+add_themes = parrot
+
+[Variables::ProhibitConditionalDeclarations]
+add_themes = parrot
+
+[Bangs::ProhibitFlagComments]
+add_themes = extra
Index: MANIFEST
===================================================================
--- MANIFEST    (revision 28654)
+++ MANIFEST    (working copy)
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Sun Jun 22 17:10:01 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Jun 23 02:21:20 2008 UT
 #
 # See tools/dev/install_files.pl for documentation on the
 # format of this file.
@@ -3888,6 +3888,7 @@
 tools/util/dump_pbc.pl                                      []
 tools/util/gen_release_info.pl                              []
 tools/util/ncidef2pasm.pl                                   []
+tools/util/perlcritic.conf                                  []
 tools/util/perltidy.conf                                    []
 tools/util/pgegrep                                          []
 tools/util/release.json                                     []
Index: t/codingstd/perlcritic.t
===================================================================
--- t/codingstd/perlcritic.t    (revision 28654)
+++ t/codingstd/perlcritic.t    (working copy)
@@ -1,256 +1,54 @@
 #! perl
-# Copyright (C) 2001-2007, The Perl Foundation.
+# Copyright (C) 2008, The Perl Foundation.
 # $Id$
 
 use strict;
 use warnings;
 
-use lib qw(. lib ../lib ../../lib);
+use lib qw{lib};
 
-use Fatal qw(open);
-use File::Find;
 use File::Spec;
-use Test::More;
-use Parrot::Config qw{%PConfig};
-use Parrot::Distribution;
 use Getopt::Long;
+use Parrot::Config qw(%PConfig);
+use Parrot::Distribution;
+use Test::More;
 
-BEGIN {
-    eval { require Perl::Critic; };
-    if ($@) {
-        plan skip_all => 'Perl::Critic not installed';
-    }
-    my $required_version = 1.03;
-    if ( $Perl::Critic::VERSION < $required_version ) {
-        plan skip_all => "Perl::Critic v$required_version required, 
v$Perl::Critic::VERSION found";
-    }
+eval { require Test::Perl::Critic };
+if ($@) {
+  plan( skip_all => 'Test::Perl::Critic required to criticize code');
+  exit;
 }
 
-my $perl_tidy_conf = 'tools/util/perltidy.conf';
-
-my %policies;
-my ( $list_policies_flag, $list_files_flag, @input_policies );
-my $policy_group = 'default';
-
+my $theme = 'parrot';
 GetOptions(
-    'list'      => \$list_policies_flag,
-    'listfiles' => \$list_files_flag,
-    'policy=s'  => [EMAIL PROTECTED],
-    'group=s'   => \$policy_group,         # all, default, extra
+    'theme=s'   => \$theme
 );
 
-# if we we're given a policy (or policies), set it to the policies hash
-# this still doesn't implement passing options to policies though...
-# i.e. need to be able to handle --policy=foo=>{'bar'=>baz}
-if (@input_policies) {
-    foreach my $input_policy (@input_policies) {
+my $config = File::Spec->catfile( qw{tools util perlcritic.conf} );
 
-        # now split on commas if that's been used as well
-        my @sub_policies = split( /,/, $input_policy );
-        foreach my $sub_policy (@sub_policies) {
-            $policies{$sub_policy} = 1;
-        }
-    }
-}
+Test::Perl::Critic->import(
+    -profile => $config,
+    -theme   => $theme
+);
 
-# get the files to check
-my $DIST = Parrot::Distribution->new();
+my $dist = Parrot::Distribution->new();
+my $languages_dir = File::Spec->catdir( $PConfig{build_dir}, 'languages' );
+
 my @files;
 if ( [EMAIL PROTECTED] ) {
 
-    @files = map { $_->path } $DIST->get_perl_language_files();
+    # Skip any files in languages/
+    @files = grep { ! m{^\Q$languages_dir\E} }
+             map { $_->path }
+             $dist->get_perl_language_files();
 
-    # Skip any language files...
-    my $languages_dir = File::Spec->catdir( $PConfig{build_dir}, 'languages' );
-    @files = grep { !m{\Q$languages_dir\E} } @files;
+} else {
+    @files = @ARGV;
 }
-else {
 
-    # if we're passed a directory, find all the matching files
-    # under that directory.
+plan(tests => scalar(@files));
+critic_ok($_) foreach @files;
 
-    # use $_ for the check below, as File::Find chdirs on us.
-    # RT#44441 Change this to simply return all files in the distribution
-    #     from this point down? -Coke
-    foreach my $file (@ARGV) {
-        ( -d $file )
-            ? find(
-            sub {
-                if ( -d $_ and $_ eq '.svn' ) {
-                    $File::Find::prune = 1;
-                    return;
-                }
-                if ( is_perl($_) ) {
-                    push @files, $File::Find::name;
-                }
-            },
-            $file
-            )
-            : push @files, $file;
-    }
-}
-
-if ($list_files_flag) {
-    print "Files to be tested by perlcritic:\n";
-    for my $file (@files) {
-        print $file, "\n";
-    }
-
-    exit;
-}
-
-# Add in the few cases we should care about.
-# For a list of available policies, perldoc Perl::Critic
-if ( keys %policies ) {
-
-    # if the policy is passed in on the command line, and it's one of the
-    # ones where we require certain config arguments, then set them to the
-    # ones we want here.
-
-    # XXX this information is being duplicated, we should only specify the
-    # perltidyrc once, e.g.
-
-    if ( grep /CodeLayout::RequireTidyCode/, @input_policies ) {
-        $policies{'CodeLayout::RequireTidyCode'} = { perltidyrc => 
$perl_tidy_conf };
-    }
-    elsif ( grep /CodeLayout::ProhibitHardTabs/, @input_policies ) {
-        $policies{'CodeLayout::ProhibitHardTabs'} = { allow_leading_tabs => 0 
};
-    }
-}
-else {
-    # otherwise, just run perlcritic.t normally
-
-    my %default_policies = (
-        'BuiltinFunctions::ProhibitStringySplit'          => 1,
-        'CodeLayout::ProhibitDuplicateCoda'               => 1,
-        'CodeLayout::ProhibitHardTabs'                    => { 
allow_leading_tabs => 0 },
-        'CodeLayout::ProhibitTrailingWhitespace'          => 1,
-        'CodeLayout::UseParrotCoda'                       => 1,
-        'InputOutput::ProhibitBarewordFileHandles'        => 1,
-        'InputOutput::ProhibitTwoArgOpen'                 => 1,
-        'Subroutines::ProhibitExplicitReturnUndef'        => 1,
-        'Subroutines::ProhibitSubroutinePrototypes'       => 1,
-        'TestingAndDebugging::MisplacedShebang'           => 1,
-        'TestingAndDebugging::ProhibitShebangWarningsArg' => 1,
-        'TestingAndDebugging::RequirePortableShebang'     => 1,
-        'TestingAndDebugging::RequireUseStrict'           => 1,
-        'TestingAndDebugging::RequireUseWarnings'         => 1,
-        'Variables::ProhibitConditionalDeclarations'      => 1,
-    );
-
-    # Allow some names normally proscribed by PBP.
-    my @ambiguousNames = grep {$_ ne 'abstract'}
-        
Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames::default_forbidden_words();
-
-    # These policies are not yet passing consistently.
-    my %extra_policies = (
-        'CodeLayout::RequireTidyCode' =>
-            { perltidyrc => $perl_tidy_conf },
-        'NamingConventions::ProhibitAmbiguousNames' =>
-            { forbid => join(" ", @ambiguousNames)},
-        'Subroutines::ProhibitBuiltinHomonyms'      => 1,
-        'Subroutines::RequireFinalReturn'           => 1,
-    );
-
-    # Add Perl::Critic::Bangs if it exists
-    eval { require Perl::Critic::Bangs; };
-    if ($@) {
-        diag "Perl::Critic::Bangs not installed: not testing for TODO items in 
code";
-    }
-    else {
-        $default_policies{'Bangs::ProhibitFlagComments'} = 1;
-    }
-
-    # decide which policy group to use
-    if ( $policy_group eq 'default' ) {
-        %policies = %default_policies;
-    }
-    elsif ( $policy_group eq 'extra' ) {
-        %policies = %extra_policies;
-    }
-    elsif ( $policy_group eq 'all' ) {
-        %policies = ( %default_policies, %extra_policies );
-    }
-    else {
-        warn "Unknown policy group, using 'default' policy group";
-    }
-
-    # Give a diag to let users know if this is doing anything, how to repeat.
-    if (exists $policies{'CodeLayout::RequireTidyCode'}) {
-        eval { require Perl::Tidy; };
-        if ( !$@ ) {
-            diag "Using $perl_tidy_conf for Perl::Tidy settings";
-        }
-    }
-}
-
-if ($list_policies_flag) {
-    use Data::Dumper;
-    $Data::Dumper::Indent = 1;
-    $Data::Dumper::Terse  = 1;
-    foreach my $policy ( sort keys %policies ) {
-        if ( $policies{$policy} == 1 ) {
-            print $policy, "\n";
-        }
-        else {
-            warn $policy, " => ", Dumper( \$policies{$policy} );
-        }
-    }
-    exit;
-}
-
-# the number of tests is the number of policies
-if ( keys %policies ) {
-    plan tests => scalar keys %policies;
-}
-else {
-    exit;
-}
-
-# Create a critic object with all of the policies we care about.
-
-# By default, don't complain about anything.
-my $config = Perl::Critic::Config->new( -exclude => [qr/.*/] );
-
-foreach my $policy ( keys %policies ) {
-    $config->add_policy(
-        -policy => $policy,
-        ref $policies{$policy} ? ( -config => $policies{$policy} ) : (),
-    ) or die;
-}
-
-my $critic = Perl::Critic->new(
-    -config => $config,
-    -top    => 50,
-);
-
-$Perl::Critic::Violation::FORMAT = '%f:%l.%c';
-
-my %violations = map { $_, [] } ( keys %policies );
-
-# check each file for the given policies
-foreach my $file ( sort @files ) {
-    if ( !-r $file ) {
-        diag "skipping invalid file: $file\n";
-        next;
-    }
-
-    foreach my $violation ( $critic->critique($file) ) {
-        my $policy = $violation->policy();
-        $policy =~ s/^Perl::Critic::Policy:://;
-        push @{ $violations{$policy} }, $violation->to_string();
-    }
-}
-
-foreach my $policy ( sort keys %violations ) {
-    my @violations = @{ $violations{$policy} };
-    ok( [EMAIL PROTECTED], $policy )
-        or diag( "Policy: $policy failed in "
-            . scalar @violations
-            . " instances:\n"
-            . join( "\n", @violations ) );
-}
-
 __END__
 
 =head1 NAME
@@ -261,54 +59,25 @@
 
  % prove t/codingstd/perlcritic.t
 
- % perl --policy=TestingAndDebugging::RequireUseWarnings 
t/codingstd/perlcritic.t
+ % perl --theme=extra t/codingstd/perlcritic.t
 
- % perl --group=all t/codingstd/perlcritic.t
+ % perl t/codingstd/perlcritic.t <file>
 
- % perl --group=extra t/codingstd/perlcritic.t
-
 =head1 DESCRIPTION
 
 Tests all perl source files for some very specific perl coding violations.
 
 Optionally specify directories or files on the command line to test B<only>
-those files, otherwise all files in the C<MANIFEST> will be checked.
+those files, otherwise all perl 5 files in the C<MANIFEST> will be checked.
 
-By default, this script will validate the specified files against a default
-set of policies. To run the test for a B<specific> Rule, specify it on the
-command line before any other files, as:
+This test uses a standard perlcriticrc file, located in
+F<tools/utils/perlcritic.conf>
 
- perl t/codingstd/perlcritic.t --policy=TestingAndDebugging::RequireUseWarnings
+If you wish to run a specific policy, the easiest way to do so is to 
temporarily add
+a custom theme to the configuration file and then specify that on the command
+line to this script.
 
-This will, for example, use B<only> that policy (see L<Perl::Critic> for
-more information on policies) when examining files from the manifest.
-
-Multiple policies can be specified either by separating the individual
-policies with a comma:
-
- --policy=foo,bar
-
-and/or by specifying the C<--policy> argument multiple times on the command
-line.
-
-If you just wish to get a listing of the polices that will be checked
-without actually running them, use:
-
- perl t/codingstd/perlcritic.t --list
-
-If you just wish to get a listing of the files that will be checked
-without actually running the tests, use:
-
- perl t/codingstd/perlcritic.t --listfiles
-
-Not all policies are analysed by default.  To process the extra policies,
-use the C<--group=extra> argument.  To process all policies use:
-
- perl t/codingstd/perlcritic.t --group=all
-
-=head1 BUGS AND LIMITATIONS
-
-There's no way to specify options to policies when they are specified on the
+If you wish to test a specific file, you can pass that as an argument on the
 command line.
 
 =cut

Reply via email to