lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From mar...@apache.org
Subject 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
Date Thu, 03 Dec 2009 02:54:38 GMT
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



Mime
View raw message