[perl-Glib-Object-Introspection] Add support for marshalling GParamSpec

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

commit ecb1ad30176da4254ed38073b4753a7f81e6d242
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Mon Oct 24 20:49:58 2016 +0200

    Add support for marshalling GParamSpec
    
    Required for Gtk3::ContainerClass::find_child_property and
    Gtk3::WidgetClass::find_style_property, for example.

 MANIFEST                       |    1 +
 gperl-i11n-marshal-interface.c |   64 +++++++++++++++++++++++++++++++---------
 t/param-specs.t                |   21 +++++++++++++
 3 files changed, 72 insertions(+), 14 deletions(-)
---
diff --git a/MANIFEST b/MANIFEST
index 5447709..3836ef9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -43,6 +43,7 @@ t/hashes.t
 t/inc/setup.pl
 t/interface-implementation.t
 t/objects.t
+t/param-specs.t
 t/structs.t
 t/values.t
 t/variants.t
diff --git a/gperl-i11n-marshal-interface.c b/gperl-i11n-marshal-interface.c
index dc9be8c..7faa4ad 100644
--- a/gperl-i11n-marshal-interface.c
+++ b/gperl-i11n-marshal-interface.c
@@ -158,21 +158,35 @@ sv_to_interface (GIArgInfo * arg_info,
                if (may_be_null && !gperl_sv_is_defined (sv)) {
                        arg->v_pointer = NULL;
                } else {
-                       arg->v_pointer = gperl_get_object_check (sv, get_gtype (interface));
-               }
-               if (arg->v_pointer) {
-                       GObject *object = arg->v_pointer;
-                       if (transfer == GI_TRANSFER_NOTHING &&
-                           object->ref_count == 1 &&
-                           SvTEMP (sv) && SvREFCNT (SvRV (sv)) == 1)
+                       /* GParamSpecs are represented as classes of
+                        * fundamental type, but gperl_get_object_check cannot
+                        * handle this.  So we do it here. */
+                       if (info_type == GI_INFO_TYPE_OBJECT &&
+                           g_object_info_get_fundamental (interface))
                        {
-                               cwarn ("*** Asked to hand out object without ownership transfer, "
-                                      "but object is about to be destroyed; "
-                                      "adding an additional reference for safety");
-                               transfer = GI_TRANSFER_EVERYTHING;
-                       }
-                       if (transfer >= GI_TRANSFER_CONTAINER) {
-                               g_object_ref (arg->v_pointer);
+                               GType type = G_TYPE_FUNDAMENTAL (get_gtype (interface));
+                               switch (type) {
+                                   case G_TYPE_PARAM:
+                                       arg->v_pointer = SvGParamSpec (sv);
+                                       break;
+                                   default:
+                                       ccroak ("sv_to_interface: Don't know how to handle fundamental type 
%s (%lu)\n",
+                                               g_type_name (type), type);
+                               }
+                       } else {
+                               arg->v_pointer = gperl_get_object_check (sv, get_gtype (interface));
+                               if (arg->v_pointer && transfer == GI_TRANSFER_NOTHING &&
+                                   ((GObject *) arg->v_pointer)->ref_count == 1 &&
+                                   SvTEMP (sv) && SvREFCNT (SvRV (sv)) == 1)
+                               {
+                                       cwarn ("*** Asked to hand out object without ownership transfer, "
+                                              "but object is about to be destroyed; "
+                                              "adding an additional reference for safety");
+                                       transfer = GI_TRANSFER_EVERYTHING;
+                               }
+                               if (transfer >= GI_TRANSFER_CONTAINER) {
+                                       g_object_ref (arg->v_pointer);
+                               }
                        }
                }
                break;
@@ -342,6 +356,28 @@ interface_to_sv (GITypeInfo* info, GIArgument *arg, gboolean own, GPerlI11nInvoc
 
        switch (info_type) {
            case GI_INFO_TYPE_OBJECT:
+               /* GParamSpecs are represented as classes of fundamental type,
+                * but gperl_new_object cannot handle this.  So we do it
+                * here. */
+               if (g_object_info_get_fundamental (interface)) {
+                       GType type = G_TYPE_FUNDAMENTAL (get_gtype (interface));
+                       switch (type) {
+                           case G_TYPE_PARAM:
+                               sv = newSVGParamSpec (arg->v_pointer); /* does ref & sink */
+                               /* FIXME: What if own=true and the pspec is not
+                                * floating?  Then we would leak.  We do not
+                                * have the API to detect this.  But it is
+                                * probably also quite rare. */
+                               break;
+                           default:
+                               ccroak ("interface_to_sv: Don't know how to handle fundamental type %s 
(%lu)\n",
+                                       g_type_name (type), type);
+                       }
+               } else {
+                       sv = gperl_new_object (arg->v_pointer, own);
+               }
+               break;
+
            case GI_INFO_TYPE_INTERFACE:
                sv = gperl_new_object (arg->v_pointer, own);
                break;
diff --git a/t/param-specs.t b/t/param-specs.t
new file mode 100644
index 0000000..2bc7877
--- /dev/null
+++ b/t/param-specs.t
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+
+BEGIN { require './t/inc/setup.pl' };
+
+use strict;
+use warnings;
+
+plan tests => 7;
+
+GI::param_spec_in_bool (Glib::ParamSpec->boolean ('mybool', 'mybool', 'mybool', Glib::FALSE, []));
+pass;
+
+my $ps1 = GI::param_spec_return;
+isa_ok ($ps1, 'Glib::Param::String');
+is ($ps1->get_name, 'test_param');
+is ($ps1->get_default_value, '42');
+
+my $ps2 = GI::param_spec_out;
+isa_ok ($ps2, 'Glib::Param::String');
+is ($ps2->get_name, 'test_param');
+is ($ps2->get_default_value, '42');