lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From nwelln...@apache.org
Subject [03/14] lucy-clownfish git commit: Handle circular refs when converting to Perl
Date Sat, 19 Mar 2016 17:27:13 GMT
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 <wellnhofer@aevum.de>
Authored: Tue Mar 8 11:54:53 2016 +0100
Committer: Nick Wellnhofer <wellnhofer@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);
 }


Mime
View raw message