lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From mar...@apache.org
Subject svn commit: r805219 - in /lucene/lucy/trunk/boilerplater: lib/Boilerplater/Parser.pm lib/Boilerplater/Type/Object.pm t/105-object_type.t
Date Mon, 17 Aug 2009 23:49:01 GMT
Author: marvin
Date: Mon Aug 17 23:49:01 2009
New Revision: 805219

URL: http://svn.apache.org/viewvc?rev=805219&view=rev
Log:
Commit LUCY-14, adding Boilerplater::Type::Object.

Added:
    lucene/lucy/trunk/boilerplater/lib/Boilerplater/Type/Object.pm   (with props)
    lucene/lucy/trunk/boilerplater/t/105-object_type.t   (with props)
Modified:
    lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm

Modified: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm?rev=805219&r1=805218&r2=805219&view=diff
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm (original)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Parser.pm Mon Aug 17 23:49:01 2009
@@ -10,6 +10,7 @@
 use Boilerplater::Type::Integer;
 use Boilerplater::Type::Float;
 use Boilerplater::Type::Void;
+use Boilerplater::Type::Object;
 use Carp;
 
 our $grammar = <<'END_GRAMMAR';
@@ -56,8 +57,14 @@
     type_qualifier(s?) void_type_specifier
     { Boilerplater::Parser->new_void_type(\%item) }
 
+object_type:
+    type_qualifier(s?) object_type_specifier '*'
+    { Boilerplater::Parser->new_object_type(\%item); }
+
 type_qualifier:
       'const' 
+    | 'incremented'
+    | 'decremented'
 
 primitive_type_specifier:
       chy_integer_specifier
@@ -77,6 +84,9 @@
 void_type_specifier:
     /void(?!\w)/
 
+object_type_specifier:
+    /[A-Z]+[A-Z0-9]*[a-z]+[A-Za-z0-9]*(?!\w)/
+
 END_GRAMMAR
 
 sub new { return shift->SUPER::new($grammar) }
@@ -107,6 +117,16 @@
     return Boilerplater::Type::Void->new(%args);
 }
 
+sub new_object_type {
+    my ( undef, $item ) = @_;
+    my %args = (
+        specifier => $item->{object_type_specifier},
+        parcel    => $parcel,
+    );
+    $args{$_} = 1 for @{ $item->{'type_qualifier(s?)'} };
+    return Boilerplater::Type::Object->new(%args);
+}
+
 sub new_parcel {
     my ( undef, $item ) = @_;
     Boilerplater::Parcel->singleton(

Added: lucene/lucy/trunk/boilerplater/lib/Boilerplater/Type/Object.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/lib/Boilerplater/Type/Object.pm?rev=805219&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/lib/Boilerplater/Type/Object.pm (added)
+++ lucene/lucy/trunk/boilerplater/lib/Boilerplater/Type/Object.pm Mon Aug 17 23:49:01 2009
@@ -0,0 +1,149 @@
+use strict;
+use warnings;
+
+package Boilerplater::Type::Object;
+use base qw( Boilerplater::Type );
+use Boilerplater::Parcel;
+use Boilerplater::Util qw( verify_args );
+use Scalar::Util qw( blessed );
+use Carp;
+
+our %new_PARAMS = (
+    const       => undef,
+    specifier   => undef,
+    indirection => 1,
+    parcel      => undef,
+    incremented => 0,
+    decremented => 0,
+);
+
+sub new {
+    my ( $either, %args ) = @_;
+    verify_args( \%new_PARAMS, %args ) or confess $@;
+    my $incremented = delete $args{incremented} || 0;
+    my $decremented = delete $args{decremented} || 0;
+    my $indirection = delete $args{indirection};
+    $indirection = 1 unless defined $indirection;
+    my $self = $either->SUPER::new(%args);
+    $self->{incremented} = $incremented;
+    $self->{decremented} = $decremented;
+    $self->{indirection} = $indirection;
+    $self->{parcel} ||= Boilerplater::Parcel->default_parcel;
+    my $prefix = $self->{parcel}->get_prefix;
+
+    # Validate params.
+    confess("Indirection must be 1") unless $self->{indirection} == 1;
+    confess("Can't be both incremented and decremented")
+        if ( $incremented && $decremented );
+    confess("Missing required param 'specifier'")
+        unless defined $self->{specifier};
+    confess("Illegal specifier: '$self->{specifier}")
+        unless $self->{specifier}
+            =~ /^(?:$prefix)?[A-Z][A-Za-z0-9]*[a-z]+[A-Za-z0-9]*(?!\w)/;
+
+    # Add $prefix if necessary.
+    $self->{specifier} = $prefix . $self->{specifier}
+        unless $self->{specifier} =~ /^$prefix/;
+
+    # Cache C representation.
+    my $string = $self->const ? 'const ' : '';
+    $string .= "$self->{specifier}*";
+    $self->set_c_string($string);
+
+    # Cache boolean indicating whether this type is a string type.
+    $self->{is_string_type} = $self->{specifier} =~ /CharBuf/ ? 1 : 0;
+
+    return $self;
+}
+
+sub is_object      {1}
+sub incremented    { shift->{incremented} }
+sub decremented    { shift->{decremented} }
+sub is_string_type { shift->{is_string_type} }
+
+sub equals {
+    my ( $self, $other ) = @_;
+    return 0 unless $self->{specifier} eq $other->{specifier};
+    for (qw( const incremented decremented )) {
+        return 0 if ( $self->{$_} xor $other->{$_} );
+    }
+    return 1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Boilerplater::Type::Boilerplater - An object Type.
+
+=head1 DESCRIPTION
+
+Boilerplater::Type::Object supports object types for all classes.  The type's 
+C<specifier> must match the last component of the class name -- i.e. for the
+class "Crustacean::Lobster" it must be "Lobster".
+
+=head1 METHODS
+
+=head2 new
+
+    my $type = Boilerplater::Type::Object->new(
+        specifier   => "Obj",     # required
+        parcel      => "Boil",    # default: the default Parcel.
+        const       => undef,     # default undef
+        indirection => 1,         # default 1
+        incremented => 1,         # default 0
+        decremented => 0,         # default 0
+    );
+
+=over
+
+=item * B<specifier> - Required.  Must follow the rules for
+L<Boilerplater::Class> class name components.
+
+=item * B<parcel> - A L<Boilerplater::Parcel> or a parcel name.
+
+=item * B<const> - Should be true if the Type is const.  Note that this refers
+to the object itself and not the pointer.
+
+=item * B<indirection> - Level of indirection.  Must be 1 if supplied.
+
+=item * B<incremented> - Indicate whether the caller must take responsibility
+for an added refcount.
+
+=item * B<decremented> - Indicate whether the caller must account for
+for a refcount decrement.
+
+=back
+
+The Parcel's prefix will be prepended to the specifier by new().
+
+=head2 incremented
+
+Returns true if the Type is incremented.
+
+=head2 decremented
+
+Returns true if the Type is decremented.
+
+=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/Type/Object.pm
------------------------------------------------------------------------------
    svn:eol-style = native

Added: lucene/lucy/trunk/boilerplater/t/105-object_type.t
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/boilerplater/t/105-object_type.t?rev=805219&view=auto
==============================================================================
--- lucene/lucy/trunk/boilerplater/t/105-object_type.t (added)
+++ lucene/lucy/trunk/boilerplater/t/105-object_type.t Mon Aug 17 23:49:01 2009
@@ -0,0 +1,99 @@
+use strict;
+use warnings;
+
+use Test::More tests => 49;
+use Boilerplater::Type::Object;
+use Boilerplater::Parser;
+
+my $parser = Boilerplater::Parser->new;
+
+# Set and leave parcel.
+my $parcel = $parser->parcel_definition('parcel Boil;')
+    or die "failed to process parcel_definition";
+
+for my $bad_specifier (qw( foo fooBar Foo_Bar FOOBAR 1Foo 1FOO )) {
+    ok( !$parser->object_type_specifier($bad_specifier),
+        "reject bad object_type_specifier $bad_specifier"
+    );
+    eval {
+        my $type = Boilerplater::Type::Object->new(
+            parcel    => 'Boil',
+            specifier => $bad_specifier,
+        );
+    };
+    like( $@, qr/specifier/,
+        "constructor rejects bad specifier $bad_specifier" );
+}
+
+for my $specifier (qw( Foo FooJr FooIII Foo4th )) {
+    is( $parser->object_type_specifier($specifier),
+        $specifier, "object_type_specifier: $specifier" );
+    isa_ok( $parser->object_type("$specifier*"),
+        "Boilerplater::Type::Object", "$specifier*" );
+    isa_ok( $parser->object_type("const $specifier*"),
+        "Boilerplater::Type::Object", "const $specifier*" );
+    isa_ok( $parser->object_type("incremented $specifier*"),
+        "Boilerplater::Type::Object", "incremented $specifier*" );
+    isa_ok( $parser->object_type("decremented $specifier*"),
+        "Boilerplater::Type::Object", "decremented $specifier*" );
+}
+
+eval { my $type = Boilerplater::Type::Object->new };
+like( $@, qr/specifier/i, "specifier required" );
+
+for ( 0, 2 ) {
+    eval {
+        my $type = Boilerplater::Type::Object->new(
+            specifier   => 'Foo',
+            indirection => $_,
+        );
+    };
+    like( $@, qr/indirection/i, "invalid indirection of $_" );
+}
+
+my $foo_type    = Boilerplater::Type::Object->new( specifier => 'Foo' );
+my $another_foo = Boilerplater::Type::Object->new( specifier => 'Foo' );
+ok( $foo_type->equals($another_foo), "equals" );
+
+my $bar_type = Boilerplater::Type::Object->new( specifier => 'Bar' );
+ok( !$foo_type->equals($bar_type), "different specifier spoils equals" );
+
+my $foreign_foo = Boilerplater::Type::Object->new(
+    specifier => 'Foo',
+    parcel    => 'Foreign',
+);
+ok( !$foo_type->equals($foreign_foo), "different parcel spoils equals" );
+is( $foreign_foo->get_specifier, "foreign_Foo",
+    "prepend parcel prefix to specifier" );
+
+my $incremented_foo = Boilerplater::Type::Object->new(
+    specifier   => 'Foo',
+    incremented => 1,
+);
+ok( $incremented_foo->incremented, "incremented" );
+ok( !$foo_type->incremented,       "not incremented" );
+ok( !$foo_type->equals($incremented_foo),
+    "different incremented spoils equals"
+);
+
+my $decremented_foo = Boilerplater::Type::Object->new(
+    specifier   => 'Foo',
+    decremented => 1,
+);
+ok( $decremented_foo->decremented, "decremented" );
+ok( !$foo_type->decremented,       "not decremented" );
+ok( !$foo_type->equals($decremented_foo),
+    "different decremented spoils equals"
+);
+
+my $const_foo = Boilerplater::Type::Object->new(
+    specifier => 'Foo',
+    const     => 1,
+);
+ok( !$foo_type->equals($const_foo), "different const spoils equals" );
+like( $const_foo->to_c, qr/const/, "const included in C representation" );
+
+my $string_type = Boilerplater::Type::Object->new( specifier => 'CharBuf', );
+ok( !$foo_type->is_string_type,   "Not is_string_type" );
+ok( $string_type->is_string_type, "is_string_type" );
+

Propchange: lucene/lucy/trunk/boilerplater/t/105-object_type.t
------------------------------------------------------------------------------
    svn:eol-style = native



Mime
View raw message