Author: jkeenan
Date: Mon Mar 24 10:57:02 2008
New Revision: 26528
Added:
trunk/t/codingstd/pdd_format.t (contents, props changed)
Modified:
trunk/MANIFEST
Log:
Adding t/codingstd/pdd_format.t to check formatting of PDDs in docs/pdds/ and
docs/pdds/draft per RT 40653.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Mon Mar 24 10:57:02 2008
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by C:\usr\local\parrot\trunk\tools\dev\mk_manifest_and_skip.pl Sat
Mar 22 19:21:55 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Mar 24 16:54:59 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2943,6 +2943,7 @@
t/codingstd/gmt_utc.t []
t/codingstd/linelength.t []
t/codingstd/pccmethod_deps.t []
+t/codingstd/pdd_format.t []
t/codingstd/perlcritic.t []
t/codingstd/pir_code_coda.t []
t/codingstd/pod_todo.t []
Added: trunk/t/codingstd/pdd_format.t
==============================================================================
--- (empty file)
+++ trunk/t/codingstd/pdd_format.t Mon Mar 24 10:57:02 2008
@@ -0,0 +1,93 @@
+#! perl
+# Copyright (C) 2001-2005, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+use Carp;
+use Cwd;
+use Tie::File;
+
+my $cwd = cwd();
+my @pdddirs = (
+ qq{$cwd/docs/pdds},
+ qq{$cwd/docs/pdds/draft},
+);
+
+my @pddfiles = ();
+foreach my $dir (@pdddirs) {
+ my @pdds;
+ opendir my $DIRH, $dir
+ or croak "Unable to open directory handle: $!";
+ @pdds = map { qq|$dir/$_| } grep { m/^pdd\d{2,}_.*\.pod$/ }
+ readdir $DIRH;
+ closedir $DIRH or croak "Unable to close directory handle: $!";
+ @pddfiles = (@pddfiles, @pdds);
+}
+
+my @diagnostics = ();
+foreach my $pdd (@pddfiles) {
+ my $diag = check_pdd_formatting($pdd);
+ if ( $diag ) {
+ push @diagnostics, $diag;
+ }
+}
+
+my $errmsg = q{};
+if ( @diagnostics ) {
+ $errmsg = join ("\n" => @diagnostics) . "\n";
+}
+
+$errmsg ? fail( qq{\n$errmsg} )
+ : pass( q{All PDDs are formatted correctly} );
+
+sub check_pdd_formatting {
+ my $pdd = shift;
+ my $base = $pdd;
+ if ($pdd =~ m{((draft/)?[^/]+)$}) {
+ $base = $1;
+ }
+ my $diag = q{};
+ my @toolong = ();
+ my @sections_needed = qw(
+ NAME
+ VERSION
+ ABSTRACT
+ SYNOPSIS
+ DESCRIPTION
+ IMPLEMENTATION
+ REFERENCES
+ );
+ my %sections_seen = map { $_, 0 } @sections_needed;
+ my @lines;
+ tie @lines, 'Tie::File', $pdd
+ or croak "Unable to tie to $pdd: $!";
+ for (my $i=0; $i<=$#lines; $i++) {
+ push @toolong, ($i + 1) if length( $lines[$i] ) > 78;
+ foreach my $need ( @sections_needed ) {
+ $sections_seen{$need}++ if $lines[$i] =~ m{^=head1\s+$need};
+ }
+ }
+ untie @lines or croak "Unable to untie from $pdd: $!";
+ if ( @toolong ) {
+ $diag .=
+ qq{$base has } .
+ scalar(@toolong) .
+ qq{ lines > 78 chars: @toolong\n};
+ }
+ foreach my $need ( keys %sections_seen ) {
+ if ( ! $sections_seen{$need} ) {
+ $diag .= qq{$base lacks 'head1' $need section\n};
+ }
+ }
+ return $diag;
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
