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/12/03 03:54:38 UTC
svn commit: r886666 - in /lucene/lucy/trunk/perl: lib/Lucy.pm
t/binding/016-varray.t t/binding/019-obj.t t/binding/029-charbuf.t
Author: marvin
Date: Thu Dec 3 02:54:15 2009
New Revision: 886666
URL: http://svn.apache.org/viewvc?rev=886666&view=rev
Log:
Add features to Perl bindings for core object types. Improve testing for Perl
bindings, particularly of Lucy::Object::Obj.
Added:
lucene/lucy/trunk/perl/t/binding/016-varray.t (with props)
lucene/lucy/trunk/perl/t/binding/019-obj.t (with props)
lucene/lucy/trunk/perl/t/binding/029-charbuf.t (with props)
Modified:
lucene/lucy/trunk/perl/lib/Lucy.pm
Modified: lucene/lucy/trunk/perl/lib/Lucy.pm
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/perl/lib/Lucy.pm?rev=886666&r1=886665&r2=886666&view=diff
==============================================================================
--- lucene/lucy/trunk/perl/lib/Lucy.pm (original)
+++ lucene/lucy/trunk/perl/lib/Lucy.pm Thu Dec 3 02:54:15 2009
@@ -37,6 +37,31 @@
}
{
+ package Lucy::Object::CharBuf;
+
+ {
+ # Defeat obscure bugs in the XS auto-generation by redefining clone()
+ # and deserialize(). (Because of how the typemap works for CharBuf*,
+ # the auto-generated methods return UTF-8 Perl scalars rather than
+ # actual CharBuf objects.)
+ no warnings 'redefine';
+ sub clone { shift->_clone(@_) }
+ }
+
+ package Lucy::Object::ViewCharBuf;
+ use Lucy::Util::ToolSet qw( confess );
+
+ sub new { confess "ViewCharBuf has no public constructor." }
+
+ package Lucy::Object::ZombieCharBuf;
+ use Lucy::Util::ToolSet qw( confess );
+
+ sub new { confess "ZombieCharBuf objects can only be created from C." }
+
+ sub DESTROY { }
+}
+
+{
package Lucy::Object::Err;
use Lucy::Util::ToolSet qw( blessed );
@@ -74,6 +99,12 @@
}
{
+ package Lucy::Object::Obj;
+ use Lucy::Util::ToolSet qw( to_lucy to_perl );
+ sub load { return $_[0]->_load( to_lucy( $_[1] ) ) }
+}
+
+{
package Lucy::Object::VArray;
no warnings 'redefine';
sub clone { CORE::shift->_clone }
Added: lucene/lucy/trunk/perl/t/binding/016-varray.t
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/perl/t/binding/016-varray.t?rev=886666&view=auto
==============================================================================
--- lucene/lucy/trunk/perl/t/binding/016-varray.t (added)
+++ lucene/lucy/trunk/perl/t/binding/016-varray.t Thu Dec 3 02:54:15 2009
@@ -0,0 +1,15 @@
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+use Lucy::Test;
+
+my ( $varray, $evil_twin );
+
+$varray = Lucy::Object::VArray->new( capacity => 5 );
+$varray->push( Lucy::Object::CharBuf->new($_) ) for 1 .. 5;
+$varray->delete(3);
+
+$evil_twin = $varray->_clone;
+is_deeply( $evil_twin->to_perl, $varray->to_perl, "clone" );
+
Propchange: lucene/lucy/trunk/perl/t/binding/016-varray.t
------------------------------------------------------------------------------
svn:eol-style = native
Added: lucene/lucy/trunk/perl/t/binding/019-obj.t
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/perl/t/binding/019-obj.t?rev=886666&view=auto
==============================================================================
--- lucene/lucy/trunk/perl/t/binding/019-obj.t (added)
+++ lucene/lucy/trunk/perl/t/binding/019-obj.t Thu Dec 3 02:54:15 2009
@@ -0,0 +1,66 @@
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+
+package TestObj;
+use base qw( Lucy::Object::Obj );
+
+our $version = $Lucy::VERSION;
+
+package SonOfTestObj;
+use base qw( TestObj );
+{
+ sub to_string {
+ my $self = shift;
+ return "STRING: " . $self->SUPER::to_string;
+ }
+}
+
+package main;
+
+ok( defined $TestObj::version,
+ "Using base class should grant access to "
+ . "package globals in the Lucy:: namespace"
+);
+
+# TODO: Port this test to C.
+eval { my $foo = Lucy::Object::Obj->new };
+like( $@, qr/abstract/i, "Obj is an abstract class" );
+
+my $object = TestObj->new;
+isa_ok( $object, "Lucy::Object::Obj",
+ "Lucy objects can be subclassed outside the Lucy hierarchy" );
+
+# TODO: Port this test to C.
+eval { my $evil_twin = $object->clone };
+like( $@, qr/abstract/i, "clone throws an abstract method exception" );
+
+ok( $object->is_a("Lucy::Object::Obj"), "custom is_a correct" );
+ok( !$object->is_a("Lucy::Object"), "custom is_a too long" );
+ok( !$object->is_a("Lucy"), "custom is_a substring" );
+ok( !$object->is_a(""), "custom is_a blank" );
+ok( !$object->is_a("thing"), "custom is_a wrong" );
+
+eval { my $another_obj = TestObj->new( kill_me_now => 1 ) };
+like( $@, qr/kill_me_now/, "reject bad param" );
+
+my $stringified_perl_obj = "$object";
+require Lucy::Object::Hash;
+my $hash = Lucy::Object::Hash->new;
+$hash->store( foo => $object );
+is( $object->get_refcount, 2, "refcount increased via C code" );
+is( $object->get_refcount, 2, "refcount increased via C code" );
+undef $object;
+$object = $hash->fetch("foo");
+is( "$object", $stringified_perl_obj, "same perl object as before" );
+
+is( $object->get_refcount, 2, "correct refcount after retrieval" );
+undef $hash;
+is( $object->get_refcount, 1,
+ "correct refcount after destruction of ref" );
+
+$object = SonOfTestObj->new;
+like( $object->to_string, qr/STRING:.*?SonOfTestObj/,
+ "overridden XS bindings can be called via SUPER" );
+
Propchange: lucene/lucy/trunk/perl/t/binding/019-obj.t
------------------------------------------------------------------------------
svn:eol-style = native
Added: lucene/lucy/trunk/perl/t/binding/029-charbuf.t
URL: http://svn.apache.org/viewvc/lucene/lucy/trunk/perl/t/binding/029-charbuf.t?rev=886666&view=auto
==============================================================================
--- lucene/lucy/trunk/perl/t/binding/029-charbuf.t (added)
+++ lucene/lucy/trunk/perl/t/binding/029-charbuf.t Thu Dec 3 02:54:15 2009
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+use lib 'buildlib';
+
+use Lucy::Test;
+use Test::More tests => 3;
+
+my $smiley = "\x{263a}";
+
+my $charbuf = Lucy::Object::CharBuf->new($smiley);
+isa_ok( $charbuf, "Lucy::Object::CharBuf" );
+is( $charbuf->to_perl, $smiley, "round trip UTF-8" );
+
+my $clone = $charbuf->clone;
+is( $clone->to_perl, Lucy::Object::CharBuf->new($smiley)->to_perl,
+ "clone" );
+
Propchange: lucene/lucy/trunk/perl/t/binding/029-charbuf.t
------------------------------------------------------------------------------
svn:eol-style = native