You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by ma...@apache.org on 2009/08/26 01:16:32 UTC
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
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