From: Bob Rogers <[EMAIL PROTECTED]>
Date: Sat, 28 Jul 2007 16:30:22 -0400
From: "jerry gay" <[EMAIL PROTECTED]>
Date: Sat, 28 Jul 2007 08:35:01 -0700
. . .
Parrot::Distribution offers a number of subroutines which allow one to
specify which subset of parrot files you wish to select for testing.
this is built into the tests, and if everything is working as it
should (and i believe it is,) it means that calling the proper
function from this distribution will provide the proper subset of
files (e.g. c_language_files.)
I want to go in the other direction, i.e. what tests should I apply for
a specific C source file, along the lines of the attached patch. It
needs doc, of course, and the correctness of %tests_from_source_category
is debatable, but that's the general idea.
I forgot to say "thanks" for pointing out the best place to add a "what
kind of file is this?" routine.
Beyond that, it would be nice if the tests themselves output
something close to the standard "grep -n" output, i.e. "file:line:" at
the start of each "hit" line. That way, if run under Emacs, the
resulting output buffer could be put into grep-mode, which would make it
easy to visit these "hits."
Proof of concept attached, better documented this time. This makes it
easy, for instance, for Emacs to jump to the "fixme" problem in
src/inter_call.c, but the "incorrect spacing between parentheses"
problem doesn't have useful line numbers (and would be hard to fix).
> P.S. I have been having problems with getting parrot-porters to accept
> my posts, so I don't expect this to appear on the list.
received just fine :)
Huh!? How could it be that you get a copy from the list and not me? I
seem to be getting everybody else's posts . . .
Duh. It's because I had "enhanced" my email forgery detector . . .
-- Bob
* tools/dev/check-coding-stds.pl (added):
+ Check files specified on the command line for coding standard
compliance. All appropriate tests are run for each file, based on
internal rules for each possible classify_file result.
* lib/Parrot/Distribution.pm:
+ (classify_file): Return source category for a given file.
* editor/parrot.el:
+ (parrot-check-coding-standards): Do a "grep" using
tools/dev/check-coding-stds.pl on buffer-file-name.
Diffs between last version checked in and current workfile(s):
Index: tools/dev/check-coding-stds.pl
===================================================================
--- tools/dev/check-coding-stds.pl (revision 0)
+++ tools/dev/check-coding-stds.pl (revision 0)
@@ -0,0 +1,145 @@
+#! perl
+# Copyright (C) 2007, The Perl Foundation.
+# $Id:$
+
+# Docs at the bottom.
+
+use strict;
+use warnings;
+
+use lib 'lib';
+
+use Parrot::Distribution;
+use Getopt::Long;
+
+my $dist = Parrot::Distribution->new();
+my $verbose_p = 0;
+
+GetOptions('verbose+' => \$verbose_p)
+ or usage();
+
+usage()
+ unless @ARGV;
+
+### Subroutines.
+
+sub usage {
+ die "Usage: $0 file ...\n";
+}
+
+my @common_tests = qw(fixme.t);
+my @c_tests = qw(c_code_coda.t c_indent.t c_struct.t cppcomments.t
+ tabs.t c_parens.t trailing_space.t);
+my %tests_from_source_category
+ = (c_source => [ @common_tests, @c_tests,
+ qw(check_toxxx.t check_isxxx.t cuddled_else.t) ],
+ c_header => [ @common_tests, @c_tests, qw(c_header_guards.t)
],
+ perl_source => [ @common_tests, "perlcritic.t --listfiles" ],
+ pir_source => [ @common_tests, qw(pir_code_coda.t) ],
+ pmc_source => [ @common_tests ],
+ yacc_source => [ @common_tests ],
+ lex_source => [ @common_tests ],
+ ops_source => [ @common_tests ],
+ );
+
+my $parrot_home_directory = $dist->{_path}
+ or die;
+my $t_codingstd_dir = "$parrot_home_directory/t/codingstd";
+
+sub test_files_for_category {
+ my $category = shift;
+
+ my $tests = $tests_from_source_category{$category};
+ return
+ unless $tests;
+ return map { "$t_codingstd_dir/$_"; } @$tests;
+}
+
+### Main code.
+
+my $n_error_lines = 0;
+for my $file (@ARGV) {
+ my $class = $dist->classify_file($file);
+ if (! $class) {
+ warn "Can't classify '$file'";
+ next;
+ }
+ warn("Processing $file (category $class):\n")
+ if $verbose_p;
+ for my $test (test_files_for_category($class)) {
+ warn(" Running test $test\n")
+ if $verbose_p;
+ open(my $test_output, "perl '$test' '$file' 2>&1 |")
+ or die;
+ # Attempt to present each test failure in "grep -n" style, for
+ # postprocessing by other tools.
+ while (defined(my $line = <$test_output>)) {
+ next
+ unless $line =~ s/^# *//;
+ $line =~ s/file '([^'']+)', line (\d+):/$1:$2:/;
+ print $line;
+ $n_error_lines++;
+ }
+ }
+}
+# This looks wrong, but see the documentation.
+exit($n_error_lines ? 0 : 1);
+
+__END__
+
+=head1 NAME
+
+tools/dev/check-coding-stds.pl - Check files for coding standard compliance
+
+=head1 SYNOPSIS
+
+ % perl tools/dev/check-coding-stds.pl [--verbose] file ...
+
+=head1 DESCRIPTION
+
+The C<check-coding-stds.pl> script runs all relevant coding standard
+tests for each file named on the command line. The tests are chosen
+based on the file type (e.g. C<c_header>, C<perl_source> identified
+for each file.
+
+The output of each test is postprocessed to strip away details of the
+C<Test::More> mechanism and make specific coding standard violations
+easier to find. Specifically, the output from normal tests is thrown
+away completely, and the failures reported on stderr are converted
+where possible into the standard "file:line:" format produced by
+C<grep -n> for further processing by other tools.
+
+As C<grep> does (perhaps counterintuitively), C<check-coding-stds.pl>
+exits with code 0 if one or more violations was found, 1 if all files
+are in full compliance, and 255 if an error happened.
+
+=head2 Options
+
+=over 4
+
+=item C<--verbose>
+
+If specified, emits warning messages for each file and test. Since
+successful tests produce no output, this is useful for figuring out
+which tests are being run.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item C<t/codingstd/*.t>
+
+=item C<editor/parrot.el>
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: tools/dev/check-coding-stds.pl
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:keywords
+ Author Date Id Revision
Index: lib/Parrot/Distribution.pm
===================================================================
--- lib/Parrot/Distribution.pm (revision 20226)
+++ lib/Parrot/Distribution.pm (working copy)
@@ -86,6 +86,8 @@
_croak( undef, "Failed to find Parrot distribution root\n" )
unless $self;
+ $self->{_path} = $path;
+
if ( defined $dist ) {
$self->_dist_files(
[
@@ -178,6 +180,7 @@
=cut
BEGIN {
+ # NB: This hash gets decorated in the loop below.
my %file_class = (
source => {
c => { file_exts => ['c'] },
@@ -217,9 +220,10 @@
'|' => map { qr{\b$_\b} }
map { quotemeta($_) } @ignore_dirs,
@exceptions;
+ # Save these for future use.
+ $file_class{$class}{$type}{extension_filter_re} = $filter_ext;
+ $file_class{$class}{$type}{directory_filter_re} = $filter_dir;
- next unless $method;
-
*{ $method . '_file_directories' } = sub {
my $self = shift;
@@ -276,6 +280,27 @@
};
}
}
+
+ sub classify_file {
+ # Return the first applicable file classification. (So far, each file
+ # fits exactly one classification.)
+ my ($self, $file) = @_;
+
+ my @result;
+ for my $class ( keys %file_class ) {
+ for my $type ( keys %{ $file_class{$class} } ) {
+ my $filter_ext
+ = $file_class{$class}{$type}{extension_filter_re};
+ next
+ unless $file =~ m|(?i)(?:$filter_ext)|;
+ my $filter_dir
+ = $file_class{$class}{$type}{directory_filter_re};
+ next
+ if $file =~ m|(?:$filter_dir)|;
+ return join('_', $type, $class);
+ }
+ }
+ }
}
=item C<get_c_language_files()>
Index: editor/parrot.el
===================================================================
--- editor/parrot.el (revision 20226)
+++ editor/parrot.el (working copy)
@@ -22,3 +22,61 @@
(statement-case-intro . *)
(inextern-lang . 0)
))))
+
+(defun parrot-home-directory-p (directory)
+ (let* ((file-name (expand-file-name "README" directory))
+ (buffer (get-file-buffer file-name))
+ (delete-p (null buffer)))
+ (unwind-protect
+ (save-excursion
+ (if (and (not buffer)
+ (file-readable-p file-name))
+ (setq buffer (find-file-noselect file-name)))
+ (if (and buffer
+ (set-buffer buffer)
+ (search-forward "This is Parrot" nil t))
+ directory))
+ (if (and buffer delete-p)
+ (kill-buffer buffer)))))
+
+(defun parrot-home-directory ()
+ "Find a directory at or above the current one which serves at the root of
+the current parrot working copy. It would be nice to cache this, but that
+would make working with multiple WCs a pain."
+ (or (parrot-home-directory-p ".")
+ (parrot-home-directory-p "..")
+ (let* ((current default-directory)
+ (result nil))
+ (while (> (length current) 1)
+ (if (setq result (parrot-home-directory-p current))
+ (setq current nil)
+ (setq current
+ (and (string-match "[^/]+/$" current)
+ (replace-match "" t t current)))))
+ result)))
+
+;; (parrot-home-directory)
+
+(defun parrot-check-coding-standards ()
+ "Run t/codingstd/*.t tests appropriate for the current buffer's file.
+The resulting 'hits', if they have line numbers, can be stepped through
+via \\[next-error] (next-error). Do 'C-h f compilation-mode RET' to see other
+commands that are available in the compilation buffer."
+ (interactive)
+ (or buffer-file-name
+ (error "Can't do this on %s, which is not a file buffer."
+ (current-buffer)))
+ (and (buffer-modified-p)
+ (y-or-n-p (format "%s is modified; save first? " (current-buffer)))
+ (save-buffer))
+ (require 'compile)
+ (let* ((home (or (parrot-home-directory)
+ (error "%S is not a Parrot working directory."
+ default-directory)))
+ (command-name (expand-file-name "tools/dev/check-coding-stds.pl" home))
+ (lib-name (expand-file-name "lib" home))
+ (command (concat "perl -Mlib=" lib-name " "
+ command-name " " buffer-file-name)))
+ '(message "executing %S with home %S, default %S"
+ command home default-directory)
+ (compilation-start command 'grep-mode)))
End of diffs.
