You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by nw...@apache.org on 2016/03/19 18:27:13 UTC
[03/14] lucy-clownfish git commit: Handle circular refs when
converting to Perl
Handle circular refs when converting to Perl
Also check for I32 overflow when converting Vector to AV.
Second half of CLOWNFISH-36.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/d9829fb0
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/d9829fb0
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/d9829fb0
Branch: refs/heads/master
Commit: d9829fb0dfdfbedc39463d19e2d1958d9a84593d
Parents: f3eea9b
Author: Nick Wellnhofer <we...@aevum.de>
Authored: Tue Mar 8 11:54:53 2016 +0100
Committer: Nick Wellnhofer <we...@aevum.de>
Committed: Thu Mar 10 14:47:23 2016 +0100
----------------------------------------------------------------------
runtime/perl/t/binding/016-vector.t | 5 +-
runtime/perl/t/binding/017-hash.t | 15 ++++--
runtime/perl/xs/XSBind.c | 83 ++++++++++++++++++++++++++++++--
3 files changed, 95 insertions(+), 8 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/d9829fb0/runtime/perl/t/binding/016-vector.t
----------------------------------------------------------------------
diff --git a/runtime/perl/t/binding/016-vector.t b/runtime/perl/t/binding/016-vector.t
index 15c3942..7f07a53 100644
--- a/runtime/perl/t/binding/016-vector.t
+++ b/runtime/perl/t/binding/016-vector.t
@@ -16,7 +16,7 @@
use strict;
use warnings;
-use Test::More tests => 3;
+use Test::More tests => 4;
use Clownfish qw( to_clownfish );
my ( $vector, $twin );
@@ -57,3 +57,6 @@ is(
'to_clownfish($arrayref) handles deep circular references'
);
+my $roundtripped = $vector->to_perl;
+is_deeply( $roundtripped, $arrayref, 'to_perl handles circular references');
+
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/d9829fb0/runtime/perl/t/binding/017-hash.t
----------------------------------------------------------------------
diff --git a/runtime/perl/t/binding/017-hash.t b/runtime/perl/t/binding/017-hash.t
index b69d8e7..f2aefa7 100644
--- a/runtime/perl/t/binding/017-hash.t
+++ b/runtime/perl/t/binding/017-hash.t
@@ -16,7 +16,7 @@
use strict;
use warnings;
-use Test::More tests => 12;
+use Test::More tests => 14;
use Clownfish qw( to_clownfish );
my $hash = Clownfish::Hash->new( capacity => 10 );
@@ -53,7 +53,16 @@ $hash = to_clownfish($hashref);
is( $$hash, ${ $hash->fetch_raw('foo') },
'to_clownfish($hashref) handles circular references' );
-$hash = to_clownfish({ key => $hashref })->fetch_raw('key');
-is( $$hash, ${ $hash->fetch_raw('bar')->fetch_raw(0) },
+my $roundtripped = $hash->to_perl;
+is_deeply( $roundtripped, $hashref, 'to_perl handles circular references' );
+
+$hashref = { key => $hashref };
+$hash = to_clownfish($hashref);
+my $val = $hash->fetch_raw('key');
+is( $$val, ${ $val->fetch_raw('bar')->fetch_raw(0) },
'to_clownfish($hashref) handles deep circular references' );
+$roundtripped = $hash->to_perl;
+is_deeply( $roundtripped, $hashref,
+ 'to_perl handles deep circular references' );
+
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/d9829fb0/runtime/perl/xs/XSBind.c
----------------------------------------------------------------------
diff --git a/runtime/perl/xs/XSBind.c b/runtime/perl/xs/XSBind.c
index 793d5eb..1fdb836 100644
--- a/runtime/perl/xs/XSBind.c
+++ b/runtime/perl/xs/XSBind.c
@@ -987,25 +987,64 @@ CFISH_BB_To_Host_IMP(cfish_ByteBuf *self, void *vcache) {
void*
CFISH_Vec_To_Host_IMP(cfish_Vector *self, void *vcache) {
dTHX;
+ cfish_ConversionCache *cache = (cfish_ConversionCache*)vcache;
+ cfish_ConversionCache new_cache;
+
+ if (cache) {
+ // Lookup Vector in conversion cache.
+ if ((cfish_Obj*)self == cache->root_obj) {
+ return newRV_inc(cache->root_sv);
+ }
+ if (cache->seen) {
+ void *cached_av = CFISH_PtrHash_Fetch(cache->seen, self);
+ if (cached_av) {
+ return newRV_inc((SV*)cached_av);
+ }
+ }
+ }
+
AV *perl_array = newAV();
- uint32_t num_elems = CFISH_Vec_Get_Size(self);
+
+ if (!cache) {
+ // Set up conversion cache.
+ cache = &new_cache;
+ cache->root_obj = (cfish_Obj*)self;
+ cache->root_sv = (SV*)perl_array;
+ cache->seen = NULL;
+ }
+ else {
+ if (!cache->seen) {
+ // Create PtrHash lazily.
+ cache->seen = cfish_PtrHash_new(0);
+ }
+ CFISH_PtrHash_Store(cache->seen, self, perl_array);
+ }
+
+ size_t num_elems = CFISH_Vec_Get_Size(self);
// Iterate over array elems.
if (num_elems) {
+ if (num_elems > I32_MAX) {
+ THROW(CFISH_ERR, "Vector too large for Perl AV");
+ }
av_fill(perl_array, num_elems - 1);
- for (uint32_t i = 0; i < num_elems; i++) {
+ for (size_t i = 0; i < num_elems; i++) {
cfish_Obj *val = CFISH_Vec_Fetch(self, i);
if (val == NULL) {
continue;
}
else {
// Recurse for each value.
- SV *const val_sv = (SV*)CFISH_Obj_To_Host(val, vcache);
+ SV *const val_sv = (SV*)CFISH_Obj_To_Host(val, cache);
av_store(perl_array, i, val_sv);
}
}
}
+ if (cache == &new_cache && cache->seen) {
+ CFISH_PtrHash_Destroy(cache->seen);
+ }
+
return newRV_noinc((SV*)perl_array);
}
@@ -1014,7 +1053,39 @@ CFISH_Vec_To_Host_IMP(cfish_Vector *self, void *vcache) {
void*
CFISH_Hash_To_Host_IMP(cfish_Hash *self, void *vcache) {
dTHX;
+ cfish_ConversionCache *cache = (cfish_ConversionCache*)vcache;
+ cfish_ConversionCache new_cache;
+
+ if (cache) {
+ // Lookup Hash in conversion cache.
+ if ((cfish_Obj*)self == cache->root_obj) {
+ return newRV_inc(cache->root_sv);
+ }
+ if (cache->seen) {
+ void *cached_hv = CFISH_PtrHash_Fetch(cache->seen, self);
+ if (cached_hv) {
+ return newRV_inc((SV*)cached_hv);
+ }
+ }
+ }
+
HV *perl_hash = newHV();
+
+ if (!cache) {
+ // Set up conversion cache.
+ cache = &new_cache;
+ cache->root_obj = (cfish_Obj*)self;
+ cache->root_sv = (SV*)perl_hash;
+ cache->seen = NULL;
+ }
+ else {
+ if (!cache->seen) {
+ // Create PtrHash lazily.
+ cache->seen = cfish_PtrHash_new(0);
+ }
+ CFISH_PtrHash_Store(cache->seen, self, perl_hash);
+ }
+
cfish_HashIterator *iter = cfish_HashIter_new(self);
// Iterate over key-value pairs.
@@ -1026,7 +1097,7 @@ CFISH_Hash_To_Host_IMP(cfish_Hash *self, void *vcache) {
// Recurse for each value.
cfish_Obj *val = CFISH_HashIter_Get_Value(iter);
SV *val_sv = val
- ? (SV*)CFISH_Obj_To_Host(val, vcache)
+ ? (SV*)CFISH_Obj_To_Host(val, cache)
: newSV(0);
// Using a negative `klen` argument to signal UTF-8 is undocumented
@@ -1034,6 +1105,10 @@ CFISH_Hash_To_Host_IMP(cfish_Hash *self, void *vcache) {
hv_store(perl_hash, key_ptr, -key_size, val_sv, 0);
}
+ if (cache == &new_cache && cache->seen) {
+ CFISH_PtrHash_Destroy(cache->seen);
+ }
+
CFISH_DECREF(iter);
return newRV_noinc((SV*)perl_hash);
}