[perl-Glib-Object-Introspection] Fix ownership handling for GInitiallyUnowned

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

commit 97d2951f773780705b154d544a5c394de62fa046
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Mon Oct 3 17:32:13 2011 +0200

    Fix ownership handling for GInitiallyUnowned
    
    GInitiallyUnowned is handled specially by gobject-introspection: return values
    inheriting from this class always have transfer-ownership=none.  This doesn't
    mix with the way Glib handles floating references.  So work around this in
    G:O:I by overriding transfer-ownership when appropriate.

 GObjectIntrospection.xs |   22 +++++++++++++++++++---
 Makefile.PL             |    2 +-
 README                  |    2 +-
 3 files changed, 21 insertions(+), 5 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index ceea9b2..00be5f9 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -124,6 +124,7 @@ typedef struct {
 	gboolean has_return_value;
 	ffi_type * return_type_ffi;
 	GITypeInfo * return_type_info;
+	GITransfer return_type_transfer;
 
 	guint current_pos;
 	guint method_offset;
@@ -2291,6 +2292,7 @@ prepare_invocation_info (GPerlI11nInvocationInfo *iinfo,
 	iinfo->has_return_value =
 		GI_TYPE_TAG_VOID != g_type_info_get_tag (iinfo->return_type_info);
 	iinfo->return_type_ffi = g_type_info_get_ffi_type (iinfo->return_type_info);
+	iinfo->return_type_transfer = g_callable_info_get_caller_owns ((GICallableInfo *) info);
 
 	/* allocate enough space for all args in both the out and in lists.
 	 * we'll only use as much as we need.  since function argument lists
@@ -2355,6 +2357,22 @@ prepare_invocation_info (GPerlI11nInvocationInfo *iinfo,
 			}
 		}
 	}
+
+	/* We need to undo the special handling that GInitiallyUnowned
+	 * descendants receive from gobject-introspection: values of this type
+	 * are always marked transfer=none, even for constructors. */
+	if (iinfo->is_constructor &&
+	    g_type_info_get_tag (iinfo->return_type_info) == GI_TYPE_TAG_INTERFACE)
+	{
+		GIBaseInfo * interface = g_type_info_get_interface (iinfo->return_type_info);
+		if (GI_IS_REGISTERED_TYPE_INFO (interface) &&
+		    g_type_is_a (g_registered_type_info_get_g_type (interface),
+		                 G_TYPE_INITIALLY_UNOWNED))
+		{
+			iinfo->return_type_transfer = GI_TRANSFER_EVERYTHING;
+		}
+		g_base_info_unref ((GIBaseInfo *) interface);
+	}
 }
 
 static void
@@ -2826,11 +2844,9 @@ invoke (class, basename, namespace, method, ...)
 #endif
 	   )
 	{
-		GITransfer return_type_transfer =
-			g_callable_info_get_caller_owns ((GICallableInfo *) info);
 		SV *value = arg_to_sv (&return_value,
 		                       iinfo.return_type_info,
-		                       return_type_transfer,
+		                       iinfo.return_type_transfer,
 		                       &iinfo);
 		if (value) {
 			XPUSHs (sv_2mortal (value));
diff --git a/Makefile.PL b/Makefile.PL
index 74730ee..7cca5b6 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -25,7 +25,7 @@ use Cwd;
 my %PREREQ_PM = (
   'ExtUtils::Depends'   => 0.300,
   'ExtUtils::PkgConfig' => 1.000,
-  'Glib'                => 1.231, # FIXME: 1.232
+  'Glib'                => 1.233,
 );
 
 my %BUILD_REQ = (
diff --git a/README b/README
index 5fe46e2..d7b1817 100644
--- a/README
+++ b/README
@@ -28,7 +28,7 @@ and these Perl modules:
 
   ExtUtils::Depends   >= 0.300
   ExtUtils::PkgConfig >= 1.000
-  Glib                >= 1.220
+  Glib                >= 1.233
 
 
 BUG REPORTS