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 <wellnho...@aevum.de> Authored: Tue Mar 8 11:54:53 2016 +0100 Committer: Nick Wellnhofer <wellnho...@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); }
