[perl-Glib-Object-Introspection] Implement support for arrays in arguments

[Emmanuele Bassi <ebassi src gnome org>]

commit 5b3bd401ceacd49059a624a1efb0e286e2ed600f
Author: Emmanuele Bassi <ebassi linux intel com>
Date:   Sun Feb 27 01:06:20 2011 +0000

    Implement support for arrays in arguments

 GObjectIntrospection.xs |   78 ++++++++++++++++++++++++++++++++++++++++++++---
 t/arrays.t              |   23 ++++++++-----
 2 files changed, 87 insertions(+), 14 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index 201bc3b..4bb685c 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -18,6 +18,8 @@
  *
  */
 
+#include <string.h>
+
 #include "gperl.h"
 #include "gperl_marshal.h"
 
@@ -635,6 +637,68 @@ array_to_sv (GITypeInfo* info,
 	return newRV_noinc ((SV *) av);
 }
 
+static gpointer
+sv_to_array (GIArgInfo *arg_info,
+             GITypeInfo *type_info,
+             SV *sv)
+{
+	AV *av;
+	GITransfer transfer, item_transfer;
+	GITypeInfo *param_info;
+	gint i, length;
+        GArray *array;
+        gboolean is_zero_terminated = FALSE;
+        gsize item_size;
+
+	dwarn ("%s: sv %p\n", G_STRFUNC, sv);
+
+	if (sv == &PL_sv_undef)
+		return NULL;
+
+	if (!gperl_sv_is_array_ref (sv))
+		ccroak ("need an array ref to convert to GArray");
+
+	av = (AV *) SvRV (sv);
+
+	transfer = g_arg_info_get_ownership_transfer (arg_info);
+        item_transfer = transfer == GI_TRANSFER_CONTAINER
+                      ? GI_TRANSFER_NOTHING
+                      : transfer;
+
+	param_info = g_type_info_get_param_type (type_info, 0);
+	dwarn ("  GArray: param_info %p with type tag %d (%s) and transfer %d\n",
+	       param_info,
+	       g_type_info_get_tag (param_info),
+	       g_type_tag_to_string (g_type_info_get_tag (param_info)),
+	       transfer);
+
+        is_zero_terminated = g_type_info_is_zero_terminated (type_info);
+        item_size = size_of_type_info (param_info);
+	length = av_len (av) + 1;
+        array = g_array_sized_new (is_zero_terminated, FALSE, item_size, length);
+
+	for (i = 0; i < length; i++) {
+		SV **svp;
+		svp = av_fetch (av, i, 0);
+		if (svp && gperl_sv_is_defined (*svp)) {
+			GIArgument arg;
+
+			dwarn ("    converting SV %p\n", *svp);
+			/* FIXME: Is it OK to always allow undef here? */
+			sv_to_arg (*svp, &arg, NULL, param_info,
+			           item_transfer, TRUE, NULL);
+
+                        g_array_insert_val (array, i, arg);
+		}
+	}
+
+	dwarn ("    -> array %p of size %d\n", array, array->len);
+
+	g_base_info_unref ((GIBaseInfo *) param_info);
+
+	return g_array_free (array, FALSE);
+}
+
 /* ------------------------------------------------------------------------- */
 
 static SV *
@@ -743,8 +807,8 @@ sv_to_glist (GIArgInfo * arg_info, GITypeInfo * type_info, SV * sv)
 			/* FIXME: Is it OK to always allow undef here? */
 			sv_to_arg (*svp, &arg, NULL, param_info,
 			           item_transfer, TRUE, NULL);
-			/* ENHANCEME: Could use g_[s]list_prepend and
-			 * later _reverse for efficiency. */
+                        /* ENHANCEME: Could use g_[s]list_prepend and
+                         * later _reverse for efficiency. */
 			if (is_slist)
 				list = g_slist_append (list, arg.v_pointer);
 			else
@@ -968,6 +1032,8 @@ sv_to_arg (SV * sv,
 {
 	GITypeTag tag = g_type_info_get_tag (type_info);
 
+        memset (arg, 0, sizeof (GIArgument));
+
 	if (!gperl_sv_is_defined (sv))
 		/* Interfaces need to be able to handle undef separately. */
 		if (!may_be_null && tag != GI_TYPE_TAG_INTERFACE)
@@ -1032,7 +1098,7 @@ sv_to_arg (SV * sv,
 		break;
 
 	    case GI_TYPE_TAG_ARRAY:
-		ccroak ("FIXME - GI_TYPE_TAG_ARRAY");
+                arg->v_pointer = sv_to_array (arg_info, type_info, sv);
 		break;
 
 	    case GI_TYPE_TAG_INTERFACE:
@@ -1907,8 +1973,10 @@ _invoke (class, basename, namespace, method, ...)
 		GITypeInfo * arg_type = g_arg_info_get_type (arg_info);
 		GITransfer transfer = g_arg_info_get_ownership_transfer (arg_info);
 		gboolean may_be_null = g_arg_info_may_be_null (arg_info);
-		guint perl_stack_pos = i + method_offset + stack_offset
-			+ invocation_info.dynamic_stack_offset;
+		guint perl_stack_pos = i
+                                     + method_offset
+                                     + stack_offset
+                                     + invocation_info.dynamic_stack_offset;
 
 		/* FIXME: Is this right?  I'm confused about the relation of
 		 * the numbers in g_callable_info_get_arg and
diff --git a/t/arrays.t b/t/arrays.t
index 4aad4a8..e5b7061 100644
--- a/t/arrays.t
+++ b/t/arrays.t
@@ -4,24 +4,29 @@ BEGIN { require './t/inc/setup.pl' };
 
 use strict;
 use warnings;
+use utf8;
 
-plan tests => 10;
+plan tests => 18;
+
+my $str_array = [ '1', '2', '3' ];
+ok (test_strv_in ($str_array));
+
+my $int_array = [ 1, 2, 3 ];
+is (test_array_int_in (3, $int_array), 6);
+is (test_array_gint8_in (3, $int_array), 6);
+is (test_array_gint16_in (3, $int_array), 6);
+is (test_array_gint32_in (3, $int_array), 6);
+is (test_array_gint64_in (3, $int_array), 6);
+is (test_array_gtype_in (2, [ 'Glib::Object', 'Glib::Int64' ]), "[GObject,gint64,]");
+is (test_array_fixed_size_int_in ([ 1, 2, 3, 4, 5 ]), 15);
 
 # TODO:
-#gboolean regress_test_strv_in (char **arr);
-#int regress_test_array_int_in (int n_ints, int *ints);
 #void regress_test_array_int_out (int *n_ints, int **ints);
 #void regress_test_array_int_inout (int *n_ints, int **ints);
-#int regress_test_array_gint8_in (int n_ints, gint8 *ints);
-#int regress_test_array_gint16_in (int n_ints, gint16 *ints);
-#gint32 regress_test_array_gint32_in (int n_ints, gint32 *ints);
-#gint64 regress_test_array_gint64_in (int n_ints, gint64 *ints);
-#char *regress_test_array_gtype_in (int n_types, GType *types);
 #char **regress_test_strv_out_container (void);
 #char **regress_test_strv_out (void);
 #const char * const * regress_test_strv_out_c (void);
 #void   regress_test_strv_outarg (char ***retp);
-#int regress_test_array_fixed_size_int_in (int *ints);
 #void regress_test_array_fixed_size_int_out (int **ints);
 #int *regress_test_array_fixed_size_int_return (void);