[perl-glib-object-introspection] Copy item memory in flat arrays when we are given ownership
- From: Torsten Schönfeld <tsch src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [perl-glib-object-introspection] Copy item memory in flat arrays when we are given ownership
- Date: Sat, 28 Sep 2019 18:04:20 +0000 (UTC)
commit 62d8c54328d6503d2daacbb8ddd83a9ba703e569
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date: Sat Sep 28 19:55:28 2019 +0200
Copy item memory in flat arrays when we are given ownership
The item memory in flat arrays is usually allocated en-bloc, so we
cannot simply assume ownership of each individual array element, as that
would lead to deallocation attempts of sub-blocks of the big
allocation. So instead we copy the individual items and free the array
memory en-bloc afterwards.
This happened for poppler_annot_text_markup_get_quadrilaterals.
https://rt.cpan.org/Public/Bug/Display.html?id=130280
https://gitlab.gnome.org/GNOME/perl-glib-object-introspection/issues/1
GObjectIntrospection.xs | 13 +++++++++++-
gperl-i11n-field.c | 2 ++
gperl-i11n-invoke-c.c | 2 ++
gperl-i11n-invoke-perl.c | 6 +++++-
gperl-i11n-marshal-arg.c | 3 ++-
gperl-i11n-marshal-array.c | 38 +++++++++++++++++----------------
gperl-i11n-marshal-hash.c | 12 +++++++++--
gperl-i11n-marshal-interface.c | 16 ++++++++++++--
gperl-i11n-marshal-list.c | 6 +++++-
t/arrays.t | 48 +++++++++++++++++++++++++++++++++++++++++-
10 files changed, 119 insertions(+), 27 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index 58fe26f..aca33f8 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -160,6 +160,11 @@ typedef struct {
GPerlI11nInvocationInfo base;
} GPerlI11nPerlInvocationInfo;
+typedef enum {
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
+ GPERL_I11N_MEMORY_SCOPE_TEMPORARY,
+} GPerlI11nMemoryScope;
+
/* callbacks */
static GPerlI11nPerlCallbackInfo * create_perl_callback_closure_for_named_sub (GIBaseInfo *cb_info, gchar
*sub_name);
static GPerlI11nPerlCallbackInfo * create_perl_callback_closure (GIBaseInfo *cb_info, SV *code);
@@ -220,6 +225,7 @@ static gboolean is_forbidden_sub_name (const gchar *name);
static SV * interface_to_sv (GITypeInfo* info,
GIArgument *arg,
gboolean own,
+ GPerlI11nMemoryScope mem_scope,
GPerlI11nInvocationInfo *iinfo);
static void sv_to_interface (GIArgInfo * arg_info,
GITypeInfo * type_info,
@@ -242,6 +248,7 @@ static void sv_to_arg (SV * sv,
static SV * arg_to_sv (GIArgument * arg,
GITypeInfo * info,
GITransfer transfer,
+ GPerlI11nMemoryScope mem_scope,
GPerlI11nInvocationInfo *iinfo);
static gpointer sv_to_callback (GIArgInfo * arg_info, GITypeInfo * type_info, SV * sv,
GPerlI11nInvocationInfo * invocation_info);
@@ -592,7 +599,11 @@ _fetch_constant (class, basename, constant)
/* FIXME: What am I suppossed to do with the return value? */
g_constant_info_get_value (info, &value);
/* No PUTBACK/SPAGAIN needed here. */
- RETVAL = arg_to_sv (&value, type_info, GI_TRANSFER_NOTHING, NULL);
+ RETVAL = arg_to_sv (&value,
+ type_info,
+ GI_TRANSFER_NOTHING,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
+ NULL);
#if GI_CHECK_VERSION (1, 30, 1)
g_constant_info_free_value (info, &value);
#endif
diff --git a/gperl-i11n-field.c b/gperl-i11n-field.c
index e43c731..372f8ef 100644
--- a/gperl-i11n-field.c
+++ b/gperl-i11n-field.c
@@ -78,6 +78,7 @@ get_field (GIFieldInfo *field_info, gpointer mem, GITransfer transfer)
sv = arg_to_sv (&value,
field_type,
GI_TRANSFER_NOTHING,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
NULL);
}
@@ -97,6 +98,7 @@ get_field (GIFieldInfo *field_info, gpointer mem, GITransfer transfer)
sv = arg_to_sv (&value,
field_type,
transfer,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
NULL);
}
diff --git a/gperl-i11n-invoke-c.c b/gperl-i11n-invoke-c.c
index a6d7dac..01d60f8 100644
--- a/gperl-i11n-invoke-c.c
+++ b/gperl-i11n-invoke-c.c
@@ -236,6 +236,7 @@ invoke_c_code (GICallableInfo *info,
value = SAVED_STACK_SV (arg_to_sv (&return_value,
&iinfo.base.return_type_info,
iinfo.base.return_type_transfer,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
&iinfo.base));
if (value) {
XPUSHs (sv_2mortal (value));
@@ -268,6 +269,7 @@ invoke_c_code (GICallableInfo *info,
sv = SAVED_STACK_SV (arg_to_sv (iinfo.out_args[i].v_pointer,
&(iinfo.base.arg_types[i]),
transfer,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
&iinfo.base));
if (sv) {
XPUSHs (sv_2mortal (sv));
diff --git a/gperl-i11n-invoke-perl.c b/gperl-i11n-invoke-perl.c
index 5dc338e..104716c 100644
--- a/gperl-i11n-invoke-perl.c
+++ b/gperl-i11n-invoke-perl.c
@@ -112,7 +112,11 @@ invoke_perl_code (ffi_cif* cif, gpointer resp, gpointer* args, gpointer userdata
? *((gpointer *) args[i+args_offset])
: args[i+args_offset];
raw_to_arg (raw, &arg, arg_type);
- sv = SAVED_STACK_SV (arg_to_sv (&arg, arg_type, transfer, &iinfo.base));
+ sv = SAVED_STACK_SV (arg_to_sv (&arg,
+ arg_type,
+ transfer,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
+ &iinfo.base));
/* If arg_to_sv returns NULL, we take that as 'skip
* this argument'; happens for GDestroyNotify, for
* example. */
diff --git a/gperl-i11n-marshal-arg.c b/gperl-i11n-marshal-arg.c
index e9d7f0a..8c27250 100644
--- a/gperl-i11n-marshal-arg.c
+++ b/gperl-i11n-marshal-arg.c
@@ -150,6 +150,7 @@ static SV *
arg_to_sv (GIArgument * arg,
GITypeInfo * info,
GITransfer transfer,
+ GPerlI11nMemoryScope mem_scope,
GPerlI11nInvocationInfo *iinfo)
{
GITypeTag tag = g_type_info_get_tag (info);
@@ -230,7 +231,7 @@ arg_to_sv (GIArgument * arg,
return array_to_sv (info, arg->v_pointer, transfer, iinfo);
case GI_TYPE_TAG_INTERFACE:
- return interface_to_sv (info, arg, own, iinfo);
+ return interface_to_sv (info, arg, own, mem_scope, iinfo);
case GI_TYPE_TAG_GLIST:
case GI_TYPE_TAG_GSLIST:
diff --git a/gperl-i11n-marshal-array.c b/gperl-i11n-marshal-array.c
index ab6fa71..3e2274d 100644
--- a/gperl-i11n-marshal-array.c
+++ b/gperl-i11n-marshal-array.c
@@ -75,6 +75,8 @@ array_to_sv (GITypeInfo *info,
GITypeInfo *param_info;
GITypeTag param_tag;
gsize item_size;
+ GITransfer item_transfer;
+ gboolean free_element_data;
gboolean need_struct_value_semantics;
gssize length = -1, i;
AV *av;
@@ -106,7 +108,9 @@ array_to_sv (GITypeInfo *info,
g_assert (iinfo && iinfo->aux_args);
conversion_sv = arg_to_sv (&(iinfo->aux_args[length_pos]),
&(iinfo->arg_types[length_pos]),
- GI_TRANSFER_NOTHING, NULL);
+ GI_TRANSFER_NOTHING,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
+ NULL);
length = SvIV (conversion_sv);
SvREFCNT_dec (conversion_sv);
}
@@ -135,6 +139,13 @@ array_to_sv (GITypeInfo *info,
param_tag = g_type_info_get_tag (param_info);
item_size = size_of_type_info (param_info);
+ /* FIXME: What about an array containing arrays of strings, where the
+ * outer array is GI_TRANSFER_EVERYTHING but the inner arrays are
+ * GI_TRANSFER_CONTAINER? */
+ item_transfer = transfer == GI_TRANSFER_EVERYTHING
+ ? GI_TRANSFER_EVERYTHING
+ : GI_TRANSFER_NOTHING;
+
av = newAV ();
need_struct_value_semantics =
@@ -152,26 +163,17 @@ array_to_sv (GITypeInfo *info,
for (i = 0; i < length; i++) {
GIArgument arg;
- SV *value;
+ SV *value = NULL;
gpointer element = elements + ((gsize) i) * item_size;
- GITransfer item_transfer;
- dwarn (" element %"G_GSSIZE_FORMAT": %p\n", i, element);
+ gpointer raw_pointer = element;
+ GPerlI11nMemoryScope mem_scope = GPERL_I11N_MEMORY_SCOPE_IRRELEVANT;
if (need_struct_value_semantics) {
- /* With struct value semantics, the values are freed
- * further below when the array itself is freed, so we
- * must not free the elements here. */
- item_transfer = GI_TRANSFER_NOTHING;
- raw_to_arg (&element, &arg, param_info);
- } else {
- /* FIXME: What about an array containing arrays of strings, where the
- * outer array is GI_TRANSFER_EVERYTHING but the inner arrays are
- * GI_TRANSFER_CONTAINER? */
- item_transfer = transfer == GI_TRANSFER_EVERYTHING
- ? GI_TRANSFER_EVERYTHING
- : GI_TRANSFER_NOTHING;
- raw_to_arg (element, &arg, param_info);
+ raw_pointer = &element;
+ mem_scope = GPERL_I11N_MEMORY_SCOPE_TEMPORARY;
}
- value = arg_to_sv (&arg, param_info, item_transfer, iinfo);
+ dwarn (" element %"G_GSSIZE_FORMAT": %p, pointer: %p\n", i, element, raw_pointer);
+ raw_to_arg (raw_pointer, &arg, param_info);
+ value = arg_to_sv (&arg, param_info, item_transfer, mem_scope, iinfo);
if (value)
av_push (av, value);
}
diff --git a/gperl-i11n-marshal-hash.c b/gperl-i11n-marshal-hash.c
index 2c5f0e8..db9809c 100644
--- a/gperl-i11n-marshal-hash.c
+++ b/gperl-i11n-marshal-hash.c
@@ -47,13 +47,21 @@ ghash_to_sv (GITypeInfo *info,
dwarn (" key pointer %p\n", key_p);
arg.v_pointer = key_p;
- key_sv = arg_to_sv (&arg, key_param_info, item_transfer, NULL);
+ key_sv = arg_to_sv (&arg,
+ key_param_info,
+ item_transfer,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
+ NULL);
if (key_sv == NULL)
break;
dwarn (" value pointer %p\n", value_p);
arg.v_pointer = value_p;
- value_sv = arg_to_sv (&arg, value_param_info, item_transfer, NULL);
+ value_sv = arg_to_sv (&arg,
+ value_param_info,
+ item_transfer,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
+ NULL);
if (value_sv == NULL)
break;
diff --git a/gperl-i11n-marshal-interface.c b/gperl-i11n-marshal-interface.c
index b81e0bf..9715209 100644
--- a/gperl-i11n-marshal-interface.c
+++ b/gperl-i11n-marshal-interface.c
@@ -317,13 +317,18 @@ sv_to_interface (GIArgInfo * arg_info,
* struct_to_sv), so it needs to be wrapped with PUTBACK/SPAGAIN by the
* caller. */
static SV *
-interface_to_sv (GITypeInfo* info, GIArgument *arg, gboolean own, GPerlI11nInvocationInfo *iinfo)
+interface_to_sv (GITypeInfo* info,
+ GIArgument *arg,
+ gboolean own,
+ GPerlI11nMemoryScope mem_scope,
+ GPerlI11nInvocationInfo *iinfo)
{
GIBaseInfo *interface;
GIInfoType info_type;
SV *sv = NULL;
dwarn ("arg %p, info %p\n", arg, info);
+ dwarn (" is pointer: %d\n", g_type_info_is_pointer (info));
interface = g_type_info_get_interface (info);
if (!interface)
@@ -382,7 +387,14 @@ interface_to_sv (GITypeInfo* info, GIArgument *arg, gboolean own, GPerlI11nInvoc
else if (g_type_is_a (type, G_TYPE_BOXED)) {
dwarn (" -> boxed: pointer=%p, type=%"G_GSIZE_FORMAT" (%s), own=%d\n",
arg->v_pointer, type, g_type_name (type), own);
- sv = gperl_new_boxed (arg->v_pointer, type, own);
+ switch (mem_scope) {
+ case GPERL_I11N_MEMORY_SCOPE_TEMPORARY:
+ g_assert (own == TRUE);
+ sv = gperl_new_boxed_copy (arg->v_pointer, type);
+ break;
+ default:
+ sv = gperl_new_boxed (arg->v_pointer, type, own);
+ }
}
#if GLIB_CHECK_VERSION (2, 24, 0)
diff --git a/gperl-i11n-marshal-list.c b/gperl-i11n-marshal-list.c
index 41c370d..a392e71 100644
--- a/gperl-i11n-marshal-list.c
+++ b/gperl-i11n-marshal-list.c
@@ -53,7 +53,11 @@ glist_to_sv (GITypeInfo* info,
GIArgument arg = {0,};
dwarn (" element %p: %p\n", i, i->data);
arg.v_pointer = i->data;
- value = arg_to_sv (&arg, param_info, item_transfer, NULL);
+ value = arg_to_sv (&arg,
+ param_info,
+ item_transfer,
+ GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
+ NULL);
if (value)
av_push (av, value);
}
diff --git a/t/arrays.t b/t/arrays.t
index f7bc1a6..5358cee 100644
--- a/t/arrays.t
+++ b/t/arrays.t
@@ -6,7 +6,7 @@ use strict;
use warnings;
use utf8;
-plan tests => 72;
+plan tests => 88;
ok (Regress::test_strv_in ([ '1', '2', '3' ]));
@@ -179,3 +179,49 @@ SKIP: {
}, 'user23');
$obj->emit_sig_with_array_len_prop ();
}
+
+# -----------------------------------------------------------------------------
+
+SKIP: {
+ my $have_poppler = eval {
+ Glib::Object::Introspection->setup (
+ basename => 'Poppler',
+ version => '0.18',
+ package => 'Poppler');
+ 1;
+ };
+ skip 'flat array tests using Poppler', 1
+ unless $have_poppler;
+
+ my $pdf = <<__PDF__; # https://github.com/mathiasbynens/small/blob/master/pdf.pdf
+%PDF-1.
+1 0 obj<</Pages 2 0 R>>endobj
+2 0 obj<</Kids[3 0 R]/Count 1>>endobj
+3 0 obj<</Parent 2 0 R>>endobj
+trailer <</Root 1 0 R>>
+__PDF__
+
+ my $doc = Poppler::Document->new_from_data ($pdf, length $pdf, undef);
+ my $quads = [
+ Glib::Boxed::new ('Poppler::Quadrilateral',
+ {p1 => {x => 0, y => 0},
+ p2 => {x => 1, y => 1},
+ p3 => {x => 2, y => 2},
+ p4 => {x => 3, y => 3}}),
+ Glib::Boxed::new ('Poppler::Quadrilateral',
+ {p1 => {x => 4, y => 4},
+ p2 => {x => 5, y => 5},
+ p3 => {x => 6, y => 6},
+ p4 => {x => 7, y => 7}}),
+ ];
+ my $rect = Glib::Boxed::new ('Poppler::Rectangle', {x1 => 0, y1 => 0, x2 => 9, y2 => 9});
+ my $annot = Poppler::AnnotTextMarkup->new_highlight ($doc, $rect, $quads);
+ my $new_quads = $annot->get_quadrilaterals ();
+ for my $index (0 .. 1) {
+ for my $point (qw/p1 p2 p3 p4/) {
+ for my $coord (qw/x y/) {
+ is ($new_quads->[$index]->$point->$coord, $quads->[$index]->$point->$coord);
+ }
+ }
+ }
+}
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
