[perl-Glib-Object-Introspection] array ↔ SV: supp ort GArray, GPtrArray and GByteArray

[Torsten Schönfeld <tsch src gnome org>]

commit f2b0048a62d775f28a4f88e651e0cb3d6a5a9c93
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Sat Feb 28 18:34:16 2015 +0100

    array ↔ SV: support GArray, GPtrArray and GByteArray

 NEWS                       |    1 +
 gperl-i11n-marshal-array.c |  258 +++++++++++++++++++++++++++++++++-----------
 t/arrays.t                 |   87 +++++++++++++++-
 3 files changed, 281 insertions(+), 65 deletions(-)
---
diff --git a/NEWS b/NEWS
index 9e5e377..b0bcbf3 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,7 @@ Overview of changes in Glib::Object::Introspection <next>
 ========================================================
 
 * Add support for marshalling GVariants.
+* Add support for marshalling GArrays, GPtrArrays and GByteArrays.
 * 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 705a8b0..e5eb459 100644
--- a/gperl-i11n-marshal-array.c
+++ b/gperl-i11n-marshal-array.c
@@ -1,12 +1,67 @@
 /* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
 
+/* Arrays containing non-basic types as non-pointers need to be treated
+ * specially.  Prime example: GValue *values = g_new0 (GValue, n);
+ */
+static gboolean
+_need_struct_value_semantics (GIArrayType array_type, GITypeInfo *param_info, GITypeTag param_tag)
+{
+       gboolean is_flat, need_struct_value_semantics;
+
+       is_flat =
+               /* is a raw array, and ... */
+               (GI_ARRAY_TYPE_C == array_type || GI_ARRAY_TYPE_ARRAY == array_type) &&
+               /* ... contains a compound type, and... */
+               !G_TYPE_TAG_IS_BASIC (param_tag) &&
+               /* ... contains non-pointers */
+               !g_type_info_is_pointer (param_info);
+
+       need_struct_value_semantics = is_flat;
+       if (GI_TYPE_TAG_INTERFACE == param_tag) {
+               /* FIXME: Try to use the invocation info here to avoid getting
+                * the interface info again? */
+               GIBaseInfo *interface_info = g_type_info_get_interface (param_info);
+               switch (g_base_info_get_type (interface_info)) {
+               case GI_INFO_TYPE_ENUM:
+               case GI_INFO_TYPE_FLAGS:
+                       need_struct_value_semantics = FALSE;
+               default:
+                       break;
+               }
+               g_base_info_unref (interface_info);
+       }
+
+       return need_struct_value_semantics;
+}
+
 static void
-free_raw_array (gpointer raw_array)
+_free_raw_array (gpointer raw_array)
 {
        dwarn ("free_raw_array %p\n", raw_array);
        g_free (raw_array);
 }
 
+static void
+_free_array (GArray *array)
+{
+       dwarn ("free_array %p\n", array);
+       g_array_free (array, TRUE);
+}
+
+static void
+_free_ptr_array (GPtrArray *array)
+{
+       dwarn ("free_ptr_array %p\n", array);
+       g_ptr_array_free (array, TRUE);
+}
+
+static void
+_free_byte_array (GByteArray *array)
+{
+       dwarn ("free_byte_array %p\n", array);
+       g_byte_array_free (array, TRUE);
+}
+
 /* This may call Perl code (via arg_to_sv), so it needs to be wrapped with
  * PUTBACK/SPAGAIN by the caller. */
 static SV *
@@ -15,75 +70,95 @@ array_to_sv (GITypeInfo *info,
              GITransfer transfer,
              GPerlI11nInvocationInfo *iinfo)
 {
+       GIArrayType array_type;
+       gpointer array = NULL, elements = NULL;
        GITypeInfo *param_info;
-       gboolean is_zero_terminated;
        GITypeTag param_tag;
        gsize item_size;
        GITransfer item_transfer;
-       gssize length, i;
        gboolean need_struct_value_semantics;
+       gssize length = -1, i;
        AV *av;
 
        if (pointer == NULL) {
                return &PL_sv_undef;
        }
 
-       is_zero_terminated = g_type_info_is_zero_terminated (info);
+       array_type = g_type_info_get_array_type (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;
+#define GET_LENGTH_AND_ELEMENTS(type, len_field, data_field) { \
+               array = pointer; \
+               length = ((type *) array)->len_field; \
+               elements = ((type *) array)->data_field; }
 
-       if (is_zero_terminated) {
-               length = g_strv_length (pointer);
-       } else {
-               length = g_type_info_get_array_fixed_size (info);
-               if (length < 0) {
-                       SV *conversion_sv;
-                       gint length_pos = g_type_info_get_array_length (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);
-                       length = SvIV (conversion_sv);
-                       SvREFCNT_dec (conversion_sv);
+       switch (array_type) {
+       case GI_ARRAY_TYPE_C:
+               array = pointer;
+               elements = pointer;
+               if (g_type_info_is_zero_terminated (info)) {
+                       length = g_strv_length (elements);
+               } else {
+                       length = g_type_info_get_array_fixed_size (info);
+                       if (length < 0) {
+                               SV *conversion_sv;
+                               gint length_pos = g_type_info_get_array_length (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);
+                               length = SvIV (conversion_sv);
+                               SvREFCNT_dec (conversion_sv);
+                       }
                }
+               break;
+       case GI_ARRAY_TYPE_ARRAY:
+               GET_LENGTH_AND_ELEMENTS (GArray, len, data);
+               break;
+       case GI_ARRAY_TYPE_PTR_ARRAY:
+               GET_LENGTH_AND_ELEMENTS (GPtrArray, len, pdata);
+               break;
+       case GI_ARRAY_TYPE_BYTE_ARRAY:
+               GET_LENGTH_AND_ELEMENTS (GByteArray, len, data);
+               break;
+       default:
+               ccroak ("Unhandled array type %d", array_type);
        }
 
+#undef GET_LENGTH_AND_ELEMENTS
+
        if (length < 0) {
                ccroak ("Could not determine the length of the array");
        }
+
+       /* 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;
+
        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);
+               _need_struct_value_semantics (array_type, param_info, param_tag);
 
-       dwarn ("    C array: pointer %p, length %"G_GSSIZE_FORMAT", item size %"G_GSIZE_FORMAT", "
+       dwarn ("    C array: pointer %p, array %p, elements %p, "
+              "length %"G_GSSIZE_FORMAT", item size %"G_GSIZE_FORMAT", "
               "param_info %p with type tag %d (%s)\n",
-              pointer,
-              length,
-              item_size,
+              pointer, array, elements,
+              length, item_size,
               param_info,
-              g_type_info_get_tag (param_info),
-              g_type_tag_to_string (g_type_info_get_tag (param_info)));
+              param_tag,
+              g_type_tag_to_string (param_tag));
 
        for (i = 0; i < length; i++) {
                GIArgument arg;
                SV *value;
-               gpointer element = pointer + ((gsize) i) * item_size;
+               gpointer element = elements + ((gsize) i) * item_size;
                if (need_struct_value_semantics) {
                        raw_to_arg (&element, &arg, param_info);
                } else {
@@ -94,8 +169,22 @@ array_to_sv (GITypeInfo *info,
                        av_push (av, value);
        }
 
-       if (transfer >= GI_TRANSFER_CONTAINER)
-               g_free (pointer);
+       if (transfer >= GI_TRANSFER_CONTAINER) {
+               switch (array_type) {
+               case GI_ARRAY_TYPE_C:
+                       _free_raw_array (array);
+                       break;
+               case GI_ARRAY_TYPE_ARRAY:
+                       _free_array (array);
+                       break;
+               case GI_ARRAY_TYPE_PTR_ARRAY:
+                       _free_ptr_array (array);
+                       break;
+               case GI_ARRAY_TYPE_BYTE_ARRAY:
+                       _free_byte_array (array);
+                       break;
+               }
+       }
 
        g_base_info_unref ((GIBaseInfo *) param_info);
 
@@ -109,16 +198,18 @@ sv_to_array (GITransfer transfer,
              GPerlI11nInvocationInfo *iinfo)
 {
        AV *av;
+       GIArrayType array_type;
        GITransfer item_transfer;
        GITypeInfo *param_info;
        GITypeTag param_tag;
        gint length_pos;
        gsize i, length;
        GPerlI11nArrayInfo *array_info = NULL;
-        GArray *array;
-        gpointer raw_array;
-        gboolean is_zero_terminated = FALSE;
-        gsize item_size;
+       gpointer array = NULL;
+       gpointer return_array;
+       GFunc return_array_free_func;
+       gboolean is_zero_terminated = FALSE;
+       gsize item_size;
        gboolean need_struct_value_semantics;
 
        dwarn ("%s: sv %p\n", G_STRFUNC, sv);
@@ -140,6 +231,8 @@ sv_to_array (GITransfer transfer,
        if (!gperl_sv_is_array_ref (sv))
                ccroak ("need an array ref to convert to GArray");
 
+       array_type = g_type_info_get_array_type (type_info);
+
        av = (AV *) SvRV (sv);
 
        item_transfer = transfer == GI_TRANSFER_CONTAINER
@@ -153,19 +246,27 @@ sv_to_array (GITransfer transfer,
               g_type_tag_to_string (g_type_info_get_tag (param_info)),
               transfer);
 
+       need_struct_value_semantics =
+               _need_struct_value_semantics (array_type, param_info, param_tag);
        is_zero_terminated = g_type_info_is_zero_terminated (type_info);
        item_size = size_of_type_info (param_info);
        length = (gsize) (av_len (av) + 1); /* av_len always returns at least -1 */
-       array = g_array_sized_new (is_zero_terminated, FALSE, item_size, length);
 
-       /* 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);
+       switch (array_type) {
+       case GI_ARRAY_TYPE_C:
+       case GI_ARRAY_TYPE_ARRAY:
+               array = g_array_sized_new (is_zero_terminated, FALSE, item_size, length);
+               break;
+       case GI_ARRAY_TYPE_PTR_ARRAY:
+               array = g_ptr_array_sized_new (length);
+               g_ptr_array_set_size (array, length);
+               break;
+       case GI_ARRAY_TYPE_BYTE_ARRAY:
+               array = g_byte_array_sized_new (length);
+               g_byte_array_set_size (array, length);
+               break;
+       }
+
        for (i = 0; i < length; i++) {
                SV **svp;
                svp = av_fetch (av, i, 0);
@@ -177,14 +278,25 @@ sv_to_array (GITransfer transfer,
                        sv_to_arg (*svp, &arg, NULL, param_info,
                                   item_transfer, TRUE, NULL);
 
-                       if (need_struct_value_semantics) {
-                               /* Copy from the memory area pointed to by
-                                * arg.v_pointer. */
-                               g_array_insert_vals (array, i, arg.v_pointer, 1);
-                       } else {
-                               /* Copy from &arg, i.e. the memory area that is
-                                * arg. */
-                               g_array_insert_val (array, i, arg);
+                       switch (array_type) {
+                       case GI_ARRAY_TYPE_C:
+                       case GI_ARRAY_TYPE_ARRAY:
+                               if (need_struct_value_semantics) {
+                                       /* Copy from the memory area pointed to by
+                                        * arg.v_pointer. */
+                                       g_array_insert_vals (array, i, arg.v_pointer, 1);
+                               } else {
+                                       /* Copy from &arg, i.e. the memory area that is
+                                        * arg. */
+                                       g_array_insert_val (array, i, arg);
+                               }
+                               break;
+                       case GI_ARRAY_TYPE_PTR_ARRAY:
+                               ((GPtrArray *) array)->pdata[i] = arg.v_pointer;
+                               break;
+                       case GI_ARRAY_TYPE_BYTE_ARRAY:
+                               ((GByteArray *) array)->data[i] = arg.v_uint8;
+                               break;
                        }
                }
        }
@@ -195,11 +307,29 @@ sv_to_array (GITransfer transfer,
                array_info->length = length;
        }
 
-       raw_array = g_array_free (array, FALSE);
-       if (GI_TRANSFER_NOTHING == transfer)
-               free_after_call (iinfo, (GFunc) free_raw_array, raw_array);
+       return_array = array;
+       return_array_free_func = NULL;
+       switch (array_type) {
+       case GI_ARRAY_TYPE_C:
+               return_array = g_array_free (array, FALSE);
+               return_array_free_func = (GFunc) _free_raw_array;
+               break;
+       case GI_ARRAY_TYPE_ARRAY:
+               return_array_free_func = (GFunc) _free_array;
+               break;
+       case GI_ARRAY_TYPE_PTR_ARRAY:
+               return_array_free_func = (GFunc) _free_ptr_array;
+               break;
+       case GI_ARRAY_TYPE_BYTE_ARRAY:
+               return_array_free_func = (GFunc) _free_byte_array;
+               break;
+       }
+
+       if (GI_TRANSFER_NOTHING == transfer) {
+               free_after_call (iinfo, return_array_free_func, return_array);
+       }
 
        g_base_info_unref ((GIBaseInfo *) param_info);
 
-       return raw_array;
+       return return_array;
 }
diff --git a/t/arrays.t b/t/arrays.t
index 5fc309d..ff2857a 100644
--- a/t/arrays.t
+++ b/t/arrays.t
@@ -6,13 +6,14 @@ use strict;
 use warnings;
 use utf8;
 
-plan tests => 30;
+plan tests => 68;
 
 ok (Regress::test_strv_in ([ '1', '2', '3' ]));
 
 my $int_array = [ 1, 2, 3 ];
 is (Regress::test_array_int_in ($int_array), 6);
 is_deeply (Regress::test_array_int_out (), [0, 1, 2, 3, 4]);
+# FIXME: This leaks.  See <https://bugzilla.gnome.org/show_bug.cgi?id=745336>.
 is_deeply (Regress::test_array_int_inout ($int_array), [3, 4]);
 is (Regress::test_array_gint8_in ($int_array), 6);
 is (Regress::test_array_gint16_in ($int_array), 6);
@@ -53,4 +54,88 @@ is (Regress::test_gslist_null_out (), undef);
 
 # -----------------------------------------------------------------------------
 
+my $int_array_ref = [-1..2];
+my $boxed_array_ref = [map { Glib::Boxed::new ('GI::BoxedStruct', long_ => $_) } (1, 2, 3)];
+my $string_array_ref = [qw/0 1 2/];
+my $byte_array_ref = [0, ord '1', 0xFF, ord '3'];
+
+# Init-like.
+is_deeply ([GI::init_function ([qw/a b c/])], [Glib::TRUE, [qw/a b/]]);
+
+# Fixed size.
+is_deeply (GI::array_fixed_int_return (), $int_array_ref);
+is_deeply (GI::array_fixed_short_return (), $int_array_ref);
+GI::array_fixed_int_in ($int_array_ref);
+GI::array_fixed_short_in ($int_array_ref);
+is_deeply (GI::array_fixed_out (), $int_array_ref);
 is_deeply (GI::array_fixed_out_struct (), [{long_ => 7, int8 => 6}, {long_ => 6, int8 => 7}]);
+is_deeply (GI::array_fixed_inout ($int_array_ref), [reverse @$int_array_ref]);
+
+# Variable size.
+is_deeply (GI::array_return (), $int_array_ref);
+is_deeply ([GI::array_return_etc (23, 42)], [[23, 0, 1, 42], 23+42]);
+GI::array_in ($int_array_ref);
+GI::array_in_len_before ($int_array_ref);
+GI::array_in_len_zero_terminated ($int_array_ref);
+GI::array_string_in ([qw/foo bar/]);
+GI::array_uint8_in ([map { ord } qw/a b c d/]);
+GI::array_struct_in ($boxed_array_ref);
+GI::array_struct_value_in ($boxed_array_ref);
+GI::array_struct_take_in ($boxed_array_ref);
+is ($boxed_array_ref->[2]->long_, 3);
+GI::array_simple_struct_in ([map { { long_ => $_ } } (1, 2, 3)]);
+GI::multi_array_key_value_in ([qw/one two three/],
+                              [map { Glib::Object::Introspection::GValueWrapper->new ('Glib::Int', $_) } (1, 
2, 3)]);
+GI::array_enum_in ([qw/value1 value2 value3/]);
+GI::array_in_guint64_len ($int_array_ref);
+GI::array_in_guint8_len ($int_array_ref);
+is_deeply (GI::array_out (), $int_array_ref);
+is_deeply ([GI::array_out_etc (23, 42)], [[23, 0, 1, 42], 23+42]);
+is_deeply (GI::array_inout ($int_array_ref), [-2..2]);
+is_deeply ([GI::array_inout_etc (23, $int_array_ref, 42)], [[23, -1, 0, 1, 42], 23+42]);
+GI::array_in_nonzero_nonlen (23, [map { ord } qw/a b c d/]);
+
+# Zero-terminated.
+is_deeply (GI::array_zero_terminated_return (), $string_array_ref);
+is (GI::array_zero_terminated_return_null (), undef);
+is_deeply ([map { $_->long_ } @{GI::array_zero_terminated_return_struct ()}],
+           [42, 43, 44]);
+GI::array_zero_terminated_in ($string_array_ref);
+is_deeply (GI::array_zero_terminated_out (), $string_array_ref);
+is_deeply (GI::array_zero_terminated_inout ($string_array_ref), [qw/-1 0 1 2/]);
+# The variant stuff is tested in variants.t.
+
+# GArray.
+is_deeply (GI::garray_int_none_return (), $int_array_ref);
+is_deeply (GI::garray_uint64_none_return (), [0, "18446744073709551615"]);
+is_deeply (GI::garray_utf8_none_return (), $string_array_ref);
+is_deeply (GI::garray_utf8_container_return (), $string_array_ref);
+is_deeply (GI::garray_utf8_full_return (), $string_array_ref);
+GI::garray_int_none_in ($int_array_ref);
+GI::garray_uint64_none_in ([0, "18446744073709551615"]);
+GI::garray_utf8_none_in ($string_array_ref);
+is_deeply (GI::garray_utf8_none_out (), $string_array_ref);
+is_deeply (GI::garray_utf8_container_out (), $string_array_ref);
+is_deeply (GI::garray_utf8_full_out (), $string_array_ref);
+# FIXME: is_deeply (GI::garray_utf8_full_out_caller_allocated (), $string_array_ref);
+is_deeply (GI::garray_utf8_none_inout ($string_array_ref), [-2..1]);
+is_deeply (GI::garray_utf8_container_inout ($string_array_ref), [-2..1]);
+# FIXME: This leaks.  See <https://bugzilla.gnome.org/show_bug.cgi?id=745336>.
+is_deeply (GI::garray_utf8_full_inout ($string_array_ref), [-2..1]);
+
+# GPtrArray.
+is_deeply (GI::gptrarray_utf8_none_return (), $string_array_ref);
+is_deeply (GI::gptrarray_utf8_container_return (), $string_array_ref);
+is_deeply (GI::gptrarray_utf8_full_return (), $string_array_ref);
+GI::gptrarray_utf8_none_in ($string_array_ref);
+is_deeply (GI::gptrarray_utf8_none_out (), $string_array_ref);
+is_deeply (GI::gptrarray_utf8_container_out (), $string_array_ref);
+is_deeply (GI::gptrarray_utf8_full_out (), $string_array_ref);
+is_deeply (GI::gptrarray_utf8_none_inout ($string_array_ref), [-2..1]);
+is_deeply (GI::gptrarray_utf8_container_inout ($string_array_ref), [-2..1]);
+# FIXME: This leaks.  See <https://bugzilla.gnome.org/show_bug.cgi?id=745336>.
+is_deeply (GI::gptrarray_utf8_full_inout ($string_array_ref), [-2..1]);
+
+# GByteArray.
+is_deeply (GI::bytearray_full_return (), $byte_array_ref);
+GI::bytearray_none_in ($byte_array_ref);