t/codingstd/svn_id.t

   1 #! perl
   2 # Copyright (C) 2007-2009, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use Cwd;
   8 use File::Spec::Functions;
   9 use lib qw( . lib ../lib ../../lib );
  10 use Parrot::Distribution;
  11 use Test::More            tests => 1;
  12
  13 =head1 NAME
  14
  15 t/codingstd/svn_id.t - checks for an svn Id keyword line in parrot source files
  16
  17 =head1 SYNOPSIS
  18
  19     # test all files
  20     % prove t/codingstd/svn_id.t
  21
  22     # test specific files
  23     % perl t/codingstd/svn_id.t src/foo.c include/parrot/bar.h
  24
  25 =head1 DESCRIPTION
  26
  27 Makes sure that the Subversion (svn) Id keyword line (that which gets
  28 expanded to show filename, last modification date and last author
  29 information) exists within Parrot source files.
  30
  31 =head1 SEE ALSO
  32
  33 L<docs/pdds/pdd07_codingstd.pod>
  34
  35 =cut
  36
  37 my $DIST = Parrot::Distribution->new;
  38 my $cwd  = getcwd(); # cwd() has some bugs when parent directory is a symbolic link
  39
  40 # Certain files, for various reasons, cannot have an
  41 # SVN Id tag.  We exclude them from examination by this test.
  42
  43 my %known_exceptions = map {
  44         $_ => 1,
  45         ( catdir( $cwd, $_ ) ) => 1,
  46     } (
  47         catfile(qw/ examples pir quine_ord.pir/),
  48         catfile(qw/ examples streams FileLines.pir/),
  49         catfile(qw/ examples streams ParrotIO.pir/),
  50     );
  51
  52 my @files = grep { ! $known_exceptions{$_} }
  53     ( @ARGV
  54         ? <@ARGV>
  55         : map { $_->path } (
  56             $DIST->get_c_language_files(),
  57             $DIST->get_make_language_files(),
  58             $DIST->get_perl_language_files(),
  59             $DIST->get_pir_language_files(),
  60         )
  61 );
  62
  63 my @no_id_files;
  64
  65 foreach my $file (@files) {
  66
  67     my $buf = $DIST->slurp($file);
  68
  69     if ( $buf !~ m/\$Id
  70                    (?:
  71                     \$       # unexpanded tag, for git-svn users or for new files
  72                     |
  73                     :.*\$    # expanded tag, colon required
  74                    )
  75                   /xm ) {
  76         push @no_id_files, $file;
  77         next;
  78     }
  79 }
  80
  81 # run the tests
  82 ok( !scalar(@no_id_files), 'Id keyword line exists' )
  83     or diag(
  84     join
  85         $/ => "No Id keyword line found in " . scalar @no_id_files . " files:",
  86     @no_id_files
  87     );
  88
  89 # Local Variables:
  90 #   mode: cperl
  91 #   cperl-indent-level: 4
  92 #   fill-column: 100
  93 # End:
  94 # vim: expandtab shiftwidth=4: