[libglib-object-introspection-perl] 02/07: array → SV: support flat arrays

Intrigeri intrigeri at moszumanska.debian.org
Mon Apr 27 09:09:12 UTC 2015


This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to annotated tag rel-0-02-9
in repository libglib-object-introspection-perl.

commit 503e9037d25c7fcc1eded4d63f9655cda1e1523e
Author: Torsten Schönfeld <kaffeetisch at gmx.de>
Date:   Tue Feb 17 22:03:49 2015 +0100

    array → SV: support flat arrays
---
 NEWS                       |  1 +
 gperl-i11n-marshal-array.c | 27 ++++++++++++++++++++++-----
 t/arrays.t                 |  6 +++++-
 3 files changed, 28 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 384e589..9e5e377 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,7 @@ Overview of changes in Glib::Object::Introspection <next>
 ========================================================
 
 * Add support for marshalling GVariants.
+* Support flat arrays when converting from C to Perl.
 
 Overview of changes in Glib::Object::Introspection 0.028
 ========================================================
diff --git a/gperl-i11n-marshal-array.c b/gperl-i11n-marshal-array.c
index a2ddfb1..705a8b0 100644
--- a/gperl-i11n-marshal-array.c
+++ b/gperl-i11n-marshal-array.c
@@ -17,9 +17,11 @@ array_to_sv (GITypeInfo *info,
 {
 	GITypeInfo *param_info;
 	gboolean is_zero_terminated;
+	GITypeTag param_tag;
 	gsize item_size;
 	GITransfer item_transfer;
 	gssize length, i;
+	gboolean need_struct_value_semantics;
 	AV *av;
 
 	if (pointer == NULL) {
@@ -27,8 +29,6 @@ array_to_sv (GITypeInfo *info,
 	}
 
 	is_zero_terminated = g_type_info_is_zero_terminated (info);
-	param_info = g_type_info_get_param_type (info, 0);
-	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
@@ -56,9 +56,21 @@ array_to_sv (GITypeInfo *info,
 	if (length < 0) {
 		ccroak ("Could not determine the length of the array");
 	}
+	param_info = g_type_info_get_param_type (info, 0);
+	param_tag = g_type_info_get_tag (param_info);
+	item_size = size_of_type_info (param_info);
 
 	av = newAV ();
 
+	/* Arrays containing non-basic types as non-pointers need to be treated
+	 * specially.  Prime example: GValue *values = g_new0 (GValue, n);
+	 */
+	need_struct_value_semantics =
+		/* is a compound type, and... */
+		!G_TYPE_TAG_IS_BASIC (param_tag) &&
+		/* ... a non-pointer is wanted */
+		!g_type_info_is_pointer (param_info);
+
 	dwarn ("    C array: pointer %p, length %"G_GSSIZE_FORMAT", item size %"G_GSIZE_FORMAT", "
 	       "param_info %p with type tag %d (%s)\n",
 	       pointer,
@@ -69,10 +81,15 @@ array_to_sv (GITypeInfo *info,
 	       g_type_tag_to_string (g_type_info_get_tag (param_info)));
 
 	for (i = 0; i < length; i++) {
-		GIArgument *arg;
+		GIArgument arg;
 		SV *value;
-		arg = pointer + ((gsize) i) * item_size;
-		value = arg_to_sv (arg, param_info, item_transfer, iinfo);
+		gpointer element = pointer + ((gsize) i) * item_size;
+		if (need_struct_value_semantics) {
+			raw_to_arg (&element, &arg, param_info);
+		} else {
+			raw_to_arg (element, &arg, param_info);
+		}
+		value = arg_to_sv (&arg, param_info, item_transfer, iinfo);
 		if (value)
 			av_push (av, value);
 	}
diff --git a/t/arrays.t b/t/arrays.t
index 75bcde8..5fc309d 100644
--- a/t/arrays.t
+++ b/t/arrays.t
@@ -6,7 +6,7 @@ use strict;
 use warnings;
 use utf8;
 
-plan tests => 29;
+plan tests => 30;
 
 ok (Regress::test_strv_in ([ '1', '2', '3' ]));
 
@@ -50,3 +50,7 @@ Regress::test_gslist_nothing_in ($test_list);
 Regress::test_gslist_nothing_in2 ($test_list);
 Regress::test_gslist_null_in (undef);
 is (Regress::test_gslist_null_out (), undef);
+
+# -----------------------------------------------------------------------------
+
+is_deeply (GI::array_fixed_out_struct (), [{long_ => 7, int8 => 6}, {long_ => 6, int8 => 7}]);

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libglib-object-introspection-perl.git



More information about the Pkg-perl-cvs-commits mailing list