[Gnash-commit] gnash ChangeLog devtools/lib/Gnash/Distribution...

[Ann Barcomb]

CVSROOT:        /sources/gnash
Module name:    gnash
Changes by:     Ann Barcomb <ann>       07/01/31 02:54:59

Modified files:
        .              : ChangeLog 
Added files:
        devtools/lib/Gnash: Distribution.pm Utils.pm 
        devtools/testsuite: uncuddled_else.t 

Log message:
        This change introduces some libraries and an initial coding standards
        test.  More will be written about it on the dev mailing list.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/gnash/ChangeLog?cvsroot=gnash&r1=1.2200&r2=1.2201
http://cvs.savannah.gnu.org/viewcvs/gnash/devtools/lib/Gnash/Distribution.pm?cvsroot=gnash&rev=1.1
http://cvs.savannah.gnu.org/viewcvs/gnash/devtools/lib/Gnash/Utils.pm?cvsroot=gnash&rev=1.1
http://cvs.savannah.gnu.org/viewcvs/gnash/devtools/testsuite/uncuddled_else.t?cvsroot=gnash&rev=1.1

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/gnash/gnash/ChangeLog,v
retrieving revision 1.2200
retrieving revision 1.2201
diff -u -b -r1.2200 -r1.2201
--- ChangeLog   30 Jan 2007 23:05:42 -0000      1.2200
+++ ChangeLog   31 Jan 2007 02:54:59 -0000      1.2201
@@ -1,3 +1,14 @@
+2007-01-30 Ann Barcomb <address@hidden>
+
+       * Added: devtools/lib/Gnash/Distribution.pm and
+         devtools/lib/Gnash/Utils.pm
+         These libraries will be used to support the devtools/testsuite
+         tests, which are tests intended to increase conformance with
+         coding standards.
+       * Added devtools/testsuite/uncuddled_else.t
+         It is a test which searches for instances of uncuddled elses
+         in C++ source files.
+
 2007-01-30 Martin Guy <address@hidden>
 
        * config.mk.in, compatibility_include.h: Remove unused GAMESWF defines

Index: devtools/lib/Gnash/Distribution.pm
===================================================================
RCS file: devtools/lib/Gnash/Distribution.pm
diff -N devtools/lib/Gnash/Distribution.pm
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ devtools/lib/Gnash/Distribution.pm  31 Jan 2007 02:54:59 -0000      1.1
@@ -0,0 +1,288 @@
+package Gnash::Distribution;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use File::Spec;
+use FindBin qw/$Bin/;
+use File::Find;
+
+my $dist;
+
+sub new {
+    my( $class ) = @_;
+
+    return $dist if defined $dist;
+    my $self = bless {}, $class;
+    return $self->_initialize;
+}
+
+{
+    no warnings 'File::Find';
+    my @found_files;
+    sub _initialize {
+        my( $self ) = @_;
+
+        my $dist = $Bin.'/../..';
+        _croak(undef, 
+          "Failed to find distribution root; did you move the test directory?"
+        ) unless (-d $dist);
+
+        find(\&_search_for_files, $dist);
+        if( defined $dist ) {
+            $self->_dist_files( [
+                @found_files
+            ] );
+        }
+
+        return $self;
+   }
+
+   sub _search_for_files {
+       ## Get only files, which are not in the CVS directory or otherwise
+       ## related to CVS/subversion.  Prune might make this more efficient.
+       return unless (-f $_);
+       return if ($File::Find::name =~ m|/CVS/| || 
+                  $File::Find::name =~ m|/\.svn/| ||
+                  $File::Find::name =~ m|\.svnignore/| ||
+                  $File::Find::name =~ m|/\.cvsignore/|);
+
+       push @found_files, $File::Find::name;
+   }
+
+}
+
+sub _croak {
+    my( $self, @message ) = @_;
+    require Carp;
+    Carp::croak(@message);
+}
+
+BEGIN {
+    my @getter_setters = qw{ _dist_files };
+
+    for my $method ( @getter_setters ) {
+        no strict 'refs';
+
+        *$method = sub {
+            my $self = shift;
+            unless (@_) {
+                $self->{$method} ||= [];
+                return wantarray
+                    ? @{ $self->{$method} }
+                    : $self->{$method};
+            }
+            $self->{$method} = shift;
+            return $self;
+        };
+    }
+}
+
+
+BEGIN {
+    my %file_class = (
+        source => {
+            cpp    => { file_exts => ['cpp', 'cc'] },
+            m4     => { file_exts => ['m4'] },
+        },
+        header => {
+            cpp    => { file_exts => ['h'] },
+        },
+    );
+
+    ## Some of this can probably be cropped out, since we're ignoring dirs
+    my @ignore_dirs = qw{ .svn CVS };
+
+    for my $class ( keys %file_class ) {
+        for my $type ( keys %{ $file_class{$class} } ) {
+            no strict 'refs';
+
+            my @exts       = @{ $file_class{$class}{$type}{file_exts} };
+            my @exceptions = defined $file_class{$class}{$type}{except_dirs}
+                ? @{ $file_class{$class}{$type}{except_dirs} }
+                : ();
+            my $method     = join '_' => $type, $class;
+            my $filter_ext = join '|' => map { "\\.${_}\$" } @exts;
+            my $filter_dir = join '|' =>
+                map { qr{\b$_\b} }
+                map { quotemeta($_) }
+                @ignore_dirs,
+                @exceptions;
+
+            next unless $method;
+
+            *{ $method . '_file_directories' } = sub {
+                my $self = shift;
+
+                # Look through the distribution files for
+                # file endings in the proper extensions and make
+                # a hash out of the directories.
+                my %dirs =
+                    map { ( ( File::Spec->splitpath($_) )[1] => 1 ) }
+                    grep { m|(?i)(?:$filter_ext)| }
+                    $self->_dist_files;
+
+                # Filter out ignored directories
+                # and return the results
+                return
+                    sort
+                    grep {
+                      -d File::Spec->catdir($_) and File::Spec->catdir($_)
+                    } grep { !m|(?:$filter_dir)|
+                    } keys %dirs;
+            };
+
+
+            *{ $method . '_files' } = sub {
+                my( $self ) = @_;
+
+                # Look through the filelist
+                # for files ending in the proper extension(s)
+                # and return a sorted list of filenames
+                return
+                    sort
+                    grep { m|(?i)(?:$filter_ext)| }
+                    $self->_dist_files;
+            };
+        }
+    }
+}
+
+
+sub get_m4_language_files {
+    my $self = shift;
+
+    my @files = (
+        $self->m4_source_files,
+    );
+
+    my @m4_language_files = ();
+    foreach my $file ( @files ) {
+        next if $self->is_m4_exemption($file);
+        push @m4_language_files, $file;
+    }
+
+    return @m4_language_files;
+}
+
+{
+    my @exemptions;
+
+    sub is_m4_exemption {
+        my( $self, $file ) = @_;
+
+        push @exemptions => map { File::Spec->canonpath($_) } qw{
+        } unless @exemptions;
+
+        $file->path =~ /\Q$_\E$/ && return 1
+            for @exemptions;
+        return;
+    }
+}
+
+sub get_cpp_language_files {
+    my $self = shift;
+
+    my @files = (
+        $self->cpp_source_files,
+        $self->cpp_header_files,
+    );
+
+    my @cpp_language_files = ();
+    foreach my $file ( @files ) {
+        next if $self->is_cpp_exemption($file);
+        push @cpp_language_files, $file;
+    }
+
+    return @cpp_language_files;
+}
+
+
+{
+    my @exemptions;
+
+    sub is_cpp_exemption {
+        my( $self, $file ) = @_;
+
+        push @exemptions => map { File::Spec->canonpath($_) } qw{
+        } unless @exemptions;
+
+        $file->path =~ /\Q$_\E$/ && return 1
+            for @exemptions;
+        return;
+    }
+}
+
+
+1;
+
+=pod
+
+=head1 NAME
+
+Gnash::Distribution - Get information about files in the Gnash distribution
+
+=head1 SYNOPSIS
+
+    use Gnash::Distribution;
+
+    my $dist = Gnash::Distribution->new();
+    my @cpp = $dist->get_cpp_language_files();  ## Get all C++ files
+
+=head1 DESCRIPTION
+
+This module can generate a list of all files found in your checkout of
+the Gnash distribution.  Particular categories of files can then be
+requested.
+
+In order to find files, it works on the assumption that it will be used
+by files in the directory devtools/testsuite, which will be located within
+the Gnash top-level checkout directory.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+The constructor will search the file system as described above, then
+create a list of all files in the top-level checkout directory or in
+nested directories.  It will throw an exception if the distribution
+root is not found.
+
+=item get_cpp_language_files()
+
+This method will return an array containing all C++ files, which includes
+files ending with the following extensions: .h, .cc, and .cpp.
+
+=item get_m4_language_files()
+
+This method returns an array containing all files ending with the .m4
+extension.
+
+=back
+
+=head1 AUTHORS
+
+Ann Barcomb <address@hidden> and Jerry Gay, based upon ideas from the Parrot
+L<http://http://dev.perl.org/perl6/> test suite.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+=cut

Index: devtools/lib/Gnash/Utils.pm
===================================================================
RCS file: devtools/lib/Gnash/Utils.pm
diff -N devtools/lib/Gnash/Utils.pm
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ devtools/lib/Gnash/Utils.pm 31 Jan 2007 02:54:59 -0000      1.1
@@ -0,0 +1,150 @@
+package Gnash::Utils;
+
+use strict;
+use warnings;
+use Exporter 'import';
+our @EXPORT_OK = qw/
+    clean 
+    clean_cpp_comment 
+    clean_c_comment 
+    clean_single_quoted_string 
+    clean_double_quoted_string
+/;
+
+sub clean {
+    return 
+      clean_cpp_comment(
+        clean_c_comment(
+          clean_single_quoted_string(
+            clean_double_quoted_string(
+              $_[0]
+            )
+          )
+        )
+      );
+}
+
+sub clean_cpp_comment {
+    my $string = shift;
+    $string =~ s{ // .* }{}gx;
+    return $string;
+}
+
+sub clean_c_comment {
+    my $string = shift;
+    $string =~ s{ /\* .*? \*/ }{}gsx;
+    return $string;
+}
+
+sub clean_single_quoted_string {
+    my $string = shift;
+    $string =~ s{ (?: ' (?: \\\\ | \\' | [^'] )* ' ) }{}gsx;
+    return $string;
+}
+
+sub clean_double_quoted_string {
+    my $string = shift;
+    $string =~ s{ (?: " (?: \\\\ | \\" | [^"] )* " ) }{}gsx;
+    return $string;
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+Gnash::Utils - Utility functions for the coding standards test suite.
+
+=head1 SYNOPSIS
+
+    use Gnash::Utils qw/clean/;
+ 
+    clean($source_code);
+
+=head1 DESCRIPTION
+
+It is easier to run tests which check code quality if the code doesn't
+contain comments or quoted strings.  This module provides some functions
+to remove these distractions from the source code. 
+
+=head1 FUNCTIONS
+
+All functions may be optionally imported.
+
+=over 4
+
+=item clean($source)
+
+This function calls C<clean_double_quoted_string>, 
+C<clean_single_quoted_string>, C<clean_c_comment>, and C<clean_cpp_comment>
+and returns a string.  It expects to receive the entire contents of a source
+file.
+
+=item clean_cpp_comment($source)
+
+This routine removes comments which begin with C<//>.  It can operate on
+an entire file or on just a single line of source code.  It returns the
+modified input as a string.  For instance,
+    return 1; // return true
+
+becomes:
+    return 1;
+
+=item clean_c_comment($source)
+
+This function removes comments of the C</* ... */> style.  It expects
+to receive the entire source code and will return the modified code as a
+string.  For example,
+    /* This is a
+       comment */
+    return 1;
+
+becomes:
+    return 1;
+
+=item clean_single_quoted_string($source)
+
+This routine will remove single quoted strings.  It expects to receive the
+entire source code and will return the modified code as a string.  For
+instance,
+    return 'hello world';
+
+becomes
+    return ;
+
+=item clean_double_quoted_string($source)
+
+This routine will remove double quoted strings.  It expects to receive the
+entire source code and will return the modified code as a string.  For
+instance,
+    return "hello world";
+
+becomes
+    return ;
+
+=back
+
+=head1 AUTHORS
+
+Ann Barcomb <address@hidden>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+=cut
+

Index: devtools/testsuite/uncuddled_else.t
===================================================================
RCS file: devtools/testsuite/uncuddled_else.t
diff -N devtools/testsuite/uncuddled_else.t
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ devtools/testsuite/uncuddled_else.t 31 Jan 2007 02:54:59 -0000      1.1
@@ -0,0 +1,102 @@
+#! perl
+
+use strict;
+use warnings;
+
+use FindBin qw/$Bin/;
+use lib $Bin.'/../lib';
+use Test::More tests => 1;
+use Gnash::Distribution;
+use Gnash::Utils qw/clean/;
+
+my $DIST = Gnash::Distribution->new;
+
+## Jerry Gay explained that this construction was needed because Windows
+## does not get @ARGV the same way as most systems.
+my @files = @ARGV 
+    ? ( $^O eq 'MSwin32' ? <@ARGV> : @ARGV )
+    : $DIST->get_cpp_language_files();
+
+my @failures;  
+
+foreach my $path (@files) {
+    open my $fh, '<', $path
+        or die "Cannot open '$path' for reading: $!\n";
+
+    my $prefix = qq<  $path line(s):>;
+    my $message = '';
+
+    ## Read in the entire file, as some of the cleaning spans lines
+    local $/ = undef;
+    my $entire_file = clean(<$fh>);
+    my @lines = split /\n/, $entire_file;    
+
+    ## We need the array index to report the correct line number.
+    foreach my $i (0..$#lines) {
+        my $string = $lines[$i];
+
+        ## Skip unless we find uncuddled elses.  First look for left-hand
+        ## failures, then right-hand failures.
+        next unless ($string =~ /^\s*else/ || 
+                     $string =~ /^\s*}?\s*else[^{]*$/);
+        $message .= " ".($i+1);
+    }
+    push @failures => "$prefix$message\n" if ($message);
+    close $fh;
+}
+
+ok( !scalar(@failures), "uncuddled else" )
+    or diag( "uncuddled else found in ".scalar @failures." 
files:address@hidden" );
+
+=head1 NAME
+
+devtools/testsuite/uncuddled_else.t - checks for uncuddled elses in C++ source 
and headers
+
+=head1 SYNOPSIS
+
+    # test all files
+    % prove devtools/testsuite/uncuddled_else.t
+
+    # test specific files
+    % perl devtools/testsuite/uncuddled_else.t recently/modified/file
+
+=head1 DESCRIPTION
+
+This test checks for code which contains uncuddled elses.  
+
+These are examples of cuddled elses:
+    } else {
+    } else (blah) {
+
+And these are examples of uncuddled elses, which will make the test fail:
+    } else
+    {
+  
+    }
+    else {
+
+    else return false;
+
+=head1 AUTHORS
+
+Ann Barcomb <address@hidden>, based upon ideas from the Parrot
+L<http://http://dev.perl.org/perl6/> test suite.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+=cut