lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From mar...@apache.org
Subject svn commit: r807850 - in /lucene/lucy/trunk/boilerplater: lib/Boilerplater/Hierarchy.pm lib/Boilerplater/Parser.pm t/500-hierarchy.t t/bpsource/ t/bpsource/Animal.bp t/bpsource/Animal/ t/bpsource/Animal/Dog.bp t/bpsource/Animal/Util.bp
Date Tue, 25 Aug 2009 23:16:32 GMT
Author: marvin
Date: Tue Aug 25 23:16:32 2009
New Revision: 807850

URL: http://svn.apache.org/viewvc?rev=807850&view=rev
Log:
Commite LUCY-26, adding Boilerplater::Parser.

Added:
    lucene/lucy/trunk/boilerplater/lib/Boilerplater/Hierarchy.pm   (with props)
    lucene/lucy/trunk/boilerplater/t/500-hierarchy.t   (with props)
    lucene/lucy/trunk/boilerplater/t/bpsource/
    lucene/lucy/trunk/boilerplater/t/bpsource/Animal/
    lucene/lucy/trunk/boilerplater/t/bpsource/Animal.bp   (with props)
    lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Dog.bp   (with props)
    lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Util.bp   (with props)
Modified:
    lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm

Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Hierarchy.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Hierarchy.pm?rev=807850&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Hierarchy.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Hierarchy.pm Tue Aug 25 23:16:32 2009
@@ -0,0 +1,244 @@
+use strict;
+use warnings;
+
+package Boilerplater::Hierarchy;
+use Carp;
+use File::Find qw( find );
+use File::Spec::Functions qw( catfile splitpath );
+use File::Path qw( mkpath );
+use Fcntl;
+
+use Boilerplater::Util qw( slurp_file current verify_args );
+use Boilerplater::Class;
+use Boilerplater::Parser;
+
+our %new_PARAMS = (
+    source => undef,
+    dest   => undef,
+);
+
+sub new {
+    my $either = shift;
+    verify_args( \%new_PARAMS, @_ ) or confess $@;
+    my $self = bless {
+        parser => Boilerplater::Parser->new,
+        trees  => {},
+        files  => {},
+        %new_PARAMS,
+        @_,
+        },
+        ref($either) || $either;
+    for (qw( source dest)) {
+        confess("Missing required param '$_'") unless $self->{$_};
+    }
+    return $self;
+}
+
+# Accessors.
+sub get_source { shift->{source} }
+sub get_dest   { shift->{dest} }
+
+# Return flattened hierarchies.
+sub ordered_classes {
+    my $self = shift;
+    my @all;
+    for my $tree ( values %{ $self->{trees} } ) {
+        push @all, $tree->tree_to_ladder;
+    }
+    return @all;
+}
+
+sub files { values %{ shift->{files} } }
+
+# Slurp all .bp files.
+# Arrange the class objects into inheritance trees.
+sub build {
+    my $self = shift;
+    $self->_parse_bp_files;
+    $_->grow_tree for values %{ $self->{trees} };
+}
+
+sub _parse_bp_files {
+    my $self   = shift;
+    my $source = $self->{source};
+
+    # Collect filenames.
+    my @all_source_paths;
+    find(
+        {   wanted => sub {
+                if ( $File::Find::name =~ /\.bp$/ ) {
+                    push @all_source_paths, $File::Find::name
+                        unless /#/;    # skip emacs .#filename.h lock files
+                }
+            },
+            no_chdir => 1,
+            follow   => 1,    # follow symlinks if possible (noop on Windows)
+        },
+        $source,
+    );
+
+    # Process any file that has at least one class declaration.
+    my %classes;
+    for my $source_path (@all_source_paths) {
+        # Derive the name of the class that owns the module file.
+        my $source_class = $source_path;
+        $source_class =~ s/\.bp$//;
+        $source_class =~ s/^\Q$source\E\W*//
+            or die "'$source_path' doesn't start with '$source'";
+        $source_class =~ s/\W/::/g;
+
+        # Slurp, parse, add parsed file to pool.
+        my $content = slurp_file($source_path);
+        $content = $self->{parser}->strip_plain_comments($content);
+        my $file = $self->{parser}
+            ->file( $content, 0, source_class => $source_class, );
+        confess("parse error for $source_path") unless defined $file;
+        $self->{files}{$source_class} = $file;
+        for my $class ( $file->classes ) {
+            my $class_name = $class->get_class_name;
+            confess "$class_name already defined"
+                if exists $classes{$class_name};
+            $classes{$class_name} = $class;
+        }
+    }
+
+    # Wrangle the classes into hierarchies and figure out inheritance.
+    while ( my ( $class_name, $class ) = each %classes ) {
+        my $parent_name = $class->get_parent_class_name;
+        if ( defined $parent_name ) {
+            if ( not exists $classes{$parent_name} ) {
+                confess(  "parent class '$parent_name' not defined "
+                        . "for class '$class_name'" );
+            }
+            $classes{$parent_name}->add_child($class);
+        }
+        else {
+            $self->{trees}{$class_name} = $class;
+        }
+    }
+}
+
+sub propagate_modified {
+    my ( $self, $modified ) = @_;
+    # Seed the recursive write.
+    my $somebody_is_modified;
+    for my $tree ( values %{ $self->{trees} } ) {
+        next unless $self->_propagate_modified( $tree, $modified );
+        $somebody_is_modified = 1;
+    }
+    return $somebody_is_modified;
+}
+
+# Recursive helper function.
+sub _propagate_modified {
+    my ( $self, $class, $modified ) = @_;
+    my $file        = $self->{files}{ $class->get_source_class };
+    my $source_path = $file->bp_path( $self->{source} );
+    my $h_path      = $file->h_path( $self->{dest} );
+
+    if ( !current( $source_path, $h_path ) ) {
+        $modified = 1;
+    }
+
+    if ($modified) {
+        $file->set_modified($modified);
+    }
+
+    # Proceed to the next generation.
+    my $somebody_is_modified = $modified;
+    for my $kid ( $class->children ) {
+        if ( $class->final ) {
+            confess(  "Attempt to inherit from final class "
+                    . $class->get_class_name . " by "
+                    . $kid->get_class_name );
+        }
+        if ( $self->_propagate_modified( $kid, $modified ) ) {
+            $somebody_is_modified = 1;
+        }
+    }
+
+    return $somebody_is_modified;
+}
+
+1;
+
+__END__
+
+__POD__
+
+=head1 NAME
+
+Boilerplater::Hierarchy - A class hierarchy.
+
+=head1 DESCRIPTION
+
+A Boilerplater::Hierarchy consists of all the classes defined in files within
+a source directory and its subdirectories.
+
+There may be more than one tree within the Hierarchy, since all "inert"
+classes are root nodes, and since Boilerplater does not officially define any
+core classes itself from which all instantiable classes must descend.
+
+=head1 METHODS
+
+=head2 new
+
+    my $hierarchy = Boilerplater::Hierarchy->new(
+        source => undef,    # required
+        dest   => undef,    # required
+    );
+
+=over
+
+=item * B<source> - The directory we begin reading files from.
+
+=item * B<dest> - The directory where the autogenerated files will be written.
+
+=back
+
+=head2 build
+
+    $hierarchy->build;
+
+Parse every .bp file which can be found under C<source>, building up the
+object hierarchy.
+
+=head2 ordered_classes
+
+    my @classes = $hierarchy->ordered_classes;
+
+Return all Classes as a list with the property that every parent class will
+precede all of its children.
+
+=head2 propagate_modified
+
+    $hierarchy->propagate_modified($modified);
+
+Visit all File objects in the hierarchy.  If a parent node is modified, mark
+all of its children as modified.  
+
+If the supplied argument is true, mark all Files as modified.
+
+=head2 get_source get_dest
+
+Accessors.
+
+=head1 COPYRIGHT AND LICENSE
+
+    /**
+     * Copyright 2009 The Apache Software Foundation
+     *
+     * Licensed under the Apache License, Version 2.0 (the "License");
+     * you may not use this file except in compliance with the License.
+     * You may obtain a copy of the License at
+     *
+     *     http://www.apache.org/licenses/LICENSE-2.0
+     *
+     * Unless required by applicable law or agreed to in writing, software
+     * distributed under the License is distributed on an "AS IS" BASIS,
+     * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+     * implied.  See the License for the specific language governing
+     * permissions and limitations under the License.
+     */
+
+=cut

Propchange: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Hierarchy.pm
------------------------------------------------------------------------------
    svn:eol-style = native

Modified: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm?rev=807850&r1=807849&r2=807850&view=diff
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm (original)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm Tue Aug 25 23:16:32 2009
@@ -303,6 +303,16 @@
 
 sub new { return shift->SUPER::new($grammar) }
 
+sub strip_plain_comments {
+    my ( $self, $text ) = @_;
+    while ( $text =~ m#(/\*[^*].*?\*/)#ms ) {
+        my $blanked = $1;
+        $blanked =~ s/\S/ /g;
+        $text    =~ s#/\*[^*].*?\*/#$blanked#ms;
+    }
+    return $text;
+}
+
 our $parcel = undef;
 sub set_parcel { $parcel = $_[1] }
 
@@ -504,6 +514,24 @@
 not at all strict, as it relies heavily on the C parser to pick up errors such
 as misspelled type names.
 
+=head1 METHODS
+
+=head2 new
+
+Constructor, takes no arguments.
+
+=head2 strip_plain_comments
+
+    my $stripped = $parser->strip_plain_comments($code_with_comments);
+
+Remove plain C comments from supplied code.  All non-whitespace characters are
+turned to spaces; all whitespace characters are preserved, so that the number
+of lines is consistent between before and after.
+
+JavaDoc-syntax "DocuComments", which begin with "/**" are left alone.  
+
+This is a sloppy implementation which will mangle quoted comments and such.
+
 =head1 COPYRIGHT AND LICENSE
 
     /**

Added: lucene/lucy/trunk/boilerplater/t/500-hierarchy.t
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/t/500-hierarchy.t?rev=807850&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/t/500-hierarchy.t (added)
+++ lucene/lucy/trunk/boilerplater/t/500-hierarchy.t Tue Aug 25 23:16:32 2009
@@ -0,0 +1,76 @@
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+
+use Boilerplater::Hierarchy;
+use Boilerplater::Util qw( a_isa_b );
+use File::Spec::Functions qw( catfile splitpath );
+use Fcntl;
+use File::Path qw( rmtree mkpath );
+
+my %args = (
+    source => 't/bpsource',
+    dest   => 't/bpdest',
+);
+
+# Clean up.
+rmtree( $args{dest} );
+
+eval { my $death = Boilerplater::Hierarchy->new( %args, extra_arg => undef ) };
+like( $@, qr/extra_arg/, "Extra arg kills constructor" );
+
+my $hierarchy = Boilerplater::Hierarchy->new(%args);
+isa_ok( $hierarchy, "Boilerplater::Hierarchy" );
+is( $hierarchy->get_source, $args{source}, "get_source" );
+is( $hierarchy->get_dest,   $args{dest},   "get_dest" );
+
+$hierarchy->build;
+
+my @files = $hierarchy->files;
+is( scalar @files, 3, "recursed and found all three files" );
+my %files;
+for my $file (@files) {
+    die "not a File" unless isa_ok( $file, "Boilerplater::File" );
+    ok( !$file->get_modified, "start off not modified" );
+    my ($class) = grep { a_isa_b( $_, "Boilerplater::Class" ) } $file->blocks;
+    die "no class" unless $class;
+    $files{ $class->get_class_name } = $file;
+}
+my $animal = $files{'Animal'}       or die "No Animal";
+my $dog    = $files{'Animal::Dog'}  or die "No Dog";
+my $util   = $files{'Animal::Util'} or die "No Util";
+
+my @classes = $hierarchy->ordered_classes;
+is( scalar @classes, 3, "all classes" );
+for my $class (@classes) {
+    die "not a Class" unless isa_ok( $class, "Boilerplater::Class" );
+}
+
+# Generate fake C files, with times set to one second ago.
+my $one_second_ago = time() - 1;
+for my $file (@files) {
+    my $h_path = $file->h_path( $args{dest} );
+    my ( undef, $dir, undef ) = splitpath($h_path);
+    mkpath($dir);
+    sysopen( my $fh, $h_path, O_CREAT | O_EXCL | O_WRONLY )
+        or die "Can't open '$h_path': $!";
+    print $fh "#include <stdio.h>\n";    # fake content.
+    close $fh or die "Can't close '$h_path': $!";
+    utime( $one_second_ago, $one_second_ago, $h_path )
+        or die "utime failed for '$h_path': $!";
+}
+
+my $path_to_animal_bp = $animal->bp_path( $args{source} );
+utime( undef, undef, $path_to_animal_bp )
+    or die "utime for '$path_to_animal_bp' failed";    # touch
+
+$hierarchy->propagate_modified;
+
+ok( $animal->get_modified, "Animal modified" );
+ok( $dog->get_modified, "Parent's modification propagates to child's file" );
+ok( !$util->get_modified, "modification doesn't propagate to inert class" );
+
+# Clean up.
+rmtree( $args{dest} );
+

Propchange: lucene/lucy/trunk/boilerplater/t/500-hierarchy.t
------------------------------------------------------------------------------
    svn:eol-style = native

Added: lucene/lucy/trunk/boilerplater/t/bpsource/Animal.bp
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/t/bpsource/Animal.bp?rev=807850&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/t/bpsource/Animal.bp (added)
+++ lucene/lucy/trunk/boilerplater/t/bpsource/Animal.bp Tue Aug 25 23:16:32 2009
@@ -0,0 +1,3 @@
+parcel Animal;
+
+abstract class Animal { }

Propchange: lucene/lucy/trunk/boilerplater/t/bpsource/Animal.bp
------------------------------------------------------------------------------
    svn:eol-style = native

Added: lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Dog.bp
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Dog.bp?rev=807850&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Dog.bp (added)
+++ lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Dog.bp Tue Aug 25 23:16:32 2009
@@ -0,0 +1,12 @@
+parcel Animal;
+
+class Animal::Dog extends Animal {
+    public inert incremented Dog*
+    new();
+
+    public inert Dog* 
+    init(Dog *self);
+
+    public void
+    Bark(Dog *self);
+}

Propchange: lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Dog.bp
------------------------------------------------------------------------------
    svn:eol-style = native

Added: lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Util.bp
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Util.bp?rev=807850&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Util.bp (added)
+++ lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Util.bp Tue Aug 25 23:16:32 2009
@@ -0,0 +1,7 @@
+parcel Animal;
+
+inert class Animal::Util {
+    inert void
+    groom(Animal *animal);
+}
+

Propchange: lucene/lucy/trunk/boilerplater/t/bpsource/Animal/Util.bp
------------------------------------------------------------------------------
    svn:eol-style = native



Mime
View raw message