# New Ticket Created by "Paul Cochrane"
# Please include the string: [perl #40429]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=40429 >
Hi,
This patch adds a test for the perl code coda in a similar manner to
the C code coda test.
Regards,
Paul
files affected:
perl_code_coda.t
Index: t/codingstd/perl_code_coda.t
===================================================================
--- t/codingstd/perl_code_coda.t (revision 0)
+++ t/codingstd/perl_code_coda.t (revision 0)
@@ -0,0 +1,108 @@
+#! perl
+# Copyright (C) 2006, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+use lib qw( . lib ../lib ../../lib );
+use Test::More tests => 2;
+use Parrot::Distribution;
+
+
+=head1 NAME
+
+t/codingstd/perl_code_coda.t - checks for editor hint coda in perl source
+
+=head1 SYNOPSIS
+
+ # test all files
+ % prove t/codingstd/perl_code_coda.t
+
+ # test specific files
+ % perl t/codingstd/perl_code_coda.t src/foo.pl include/parrot/bar.pm
+
+=head1 DESCRIPTION
+
+Checks that all perl source files have the proper editor hints coda,
+as specified in PDD07.
+
+=head1 SEE ALSO
+
+L<docs/pdds/pdd07_codingstd.pod>
+
+=cut
+
+
+my $coda = <<'CODA';
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+CODA
+
+my $DIST = Parrot::Distribution->new;
+my @files = @ARGV ? @ARGV : perl_files();
+my @no_coda;
+my @extra_coda;
+
+foreach my $file ( @files ) {
+ my $buf;
+ my $path;
+
+ ## get the full path of the file
+ # if we have command line arguments, the file is the full path
+ if (@ARGV) {
+ $path = $file;
+ }
+ # otherwise, use the relevant Parrot:: path method
+ else {
+ $path = $file->path;
+ }
+
+ # slurp in the file
+ open(my $fh, '<', $path)
+ or die "Cannot open '$path' for reading: $!\n";
+ {
+ local $/;
+ $buf = <$fh>;
+ }
+
+ # append to the no_coda array if the code doesn't match
+ push @no_coda => "$path\n"
+ unless $buf =~ m{\Q$coda\E\n*\z};
+
+ # append to the extra_coda array if coda-like text appears more than once
+ my $vim_many =()= $buf =~ m{^ \s* \*? \s* vim: \s* $}gmx;
+ my $emacs_many =()= $buf =~ m{^ \s* \*? \s* Local variables: \s* $}gmx;
+ push @extra_coda => "$path\n"
+ if $vim_many > 1 || $emacs_many > 1;
+}
+
+ok(!scalar(@no_coda), 'Perl code coda present')
+ or diag("Perl code coda missing in "
+ . scalar @no_coda . " files:[EMAIL PROTECTED]");
+
+ok(!scalar(@extra_coda), 'Perl code coda appears only once')
+ or diag("Perl code coda repeating in "
+ . scalar @extra_coda . " files:[EMAIL PROTECTED]");
+
+exit;
+
+
+sub perl_files {
+ return (
+ map($_->files_of_type('Perl script'), $DIST->perl_script_file_directories),
+ map($_->files_of_type('Perl module'), $DIST->perl_module_file_directories),
+ );
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
