[perl-Glib-Object-Introspection] Handle GInitiallyUnowned return values from callbacks more conservatively

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

commit f26cde749eaa6fd01dfb7fa3eef567f44f0a37be
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Wed Oct 12 19:45:54 2011 +0200

    Handle GInitiallyUnowned return values from callbacks more conservatively
    
    Basically, always assume that we are to transfer ownership, i.e. add an
    additional ref.  This will lead to leaks in certain cases, but avoids
    assertions in others.

 GObjectIntrospection.xs        |    1 +
 gperl-i11n-invoke-perl.c       |   17 +++++++++++++++++
 gperl-i11n-marshal-arg.c       |    2 +-
 gperl-i11n-marshal-interface.c |   11 +++++++----
 4 files changed, 26 insertions(+), 5 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index 19bf24d..4cc9722 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -130,6 +130,7 @@ static SV * interface_to_sv (GITypeInfo* info,
                              gboolean own);
 static void sv_to_interface (GIArgInfo * arg_info,
                              GITypeInfo * type_info,
+                             GITransfer transfer,
                              SV * sv,
                              GIArgument * arg,
                              GPerlI11nInvocationInfo * invocation_info);
diff --git a/gperl-i11n-invoke-perl.c b/gperl-i11n-invoke-perl.c
index aa8fa91..b213356 100644
--- a/gperl-i11n-invoke-perl.c
+++ b/gperl-i11n-invoke-perl.c
@@ -195,6 +195,23 @@ invoke_callback (ffi_cif* cif, gpointer resp, gpointer* args, gpointer userdata)
 		       g_type_info_is_pointer (type_info),
 		       g_type_info_get_tag (type_info));
 
+		/* If the callback is supposed to return a GInitiallyUnowned
+		 * object then we must enforce GI_TRANSFER_EVERYTHING.
+		 * Otherwise, if the Perl code returns a newly created object,
+		 * FREETMPS below would finalize it. */
+		if (g_type_info_get_tag (type_info) == GI_TYPE_TAG_INTERFACE &&
+		    transfer == GI_TRANSFER_NOTHING)
+		{
+			GIBaseInfo *interface = g_type_info_get_interface (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))
+			{
+				transfer = GI_TRANSFER_EVERYTHING;
+			}
+			g_base_info_unref (interface);
+		}
+
 		sv_to_arg (POPs, &arg, NULL, type_info,
 		           transfer, may_be_null, NULL);
 		arg_to_raw (&arg, resp, type_info);
diff --git a/gperl-i11n-marshal-arg.c b/gperl-i11n-marshal-arg.c
index bbf8c70..d8766bd 100644
--- a/gperl-i11n-marshal-arg.c
+++ b/gperl-i11n-marshal-arg.c
@@ -87,7 +87,7 @@ sv_to_arg (SV * sv,
 
 	    case GI_TYPE_TAG_INTERFACE:
 		dwarn ("    type %p -> interface\n", type_info);
-		sv_to_interface (arg_info, type_info, sv, arg,
+		sv_to_interface (arg_info, type_info, transfer, sv, arg,
 		                 invocation_info);
 		break;
 
diff --git a/gperl-i11n-marshal-interface.c b/gperl-i11n-marshal-interface.c
index 7dea8c0..fc9f44d 100644
--- a/gperl-i11n-marshal-interface.c
+++ b/gperl-i11n-marshal-interface.c
@@ -50,6 +50,7 @@ instance_sv_to_pointer (GICallableInfo *info, SV *sv)
 static void
 sv_to_interface (GIArgInfo * arg_info,
                  GITypeInfo * type_info,
+                 GITransfer transfer,
                  SV * sv,
                  GIArgument * arg,
                  GPerlI11nInvocationInfo * invocation_info)
@@ -68,8 +69,13 @@ sv_to_interface (GIArgInfo * arg_info,
 	switch (info_type) {
 	    case GI_INFO_TYPE_OBJECT:
 	    case GI_INFO_TYPE_INTERFACE:
-		/* FIXME: Check transfer setting. */
 		arg->v_pointer = gperl_get_object (sv);
+		if (arg->v_pointer && transfer == GI_TRANSFER_EVERYTHING) {
+			g_object_ref (arg->v_pointer);
+			if (G_IS_INITIALLY_UNOWNED (arg->v_pointer)) {
+				g_object_force_floating (arg->v_pointer);
+			}
+		}
 		break;
 
 	    case GI_INFO_TYPE_UNION:
@@ -82,9 +88,6 @@ sv_to_interface (GIArgInfo * arg_info,
 		GType type = g_registered_type_info_get_g_type (
 		               (GIRegisteredTypeInfo *) interface);
 		if (!type || type == G_TYPE_NONE) {
-			GITransfer transfer = arg_info
-				? g_arg_info_get_ownership_transfer (arg_info)
-				: GI_TRANSFER_NOTHING;
 			dwarn ("    unboxed type\n");
 			g_assert (!need_value_semantics);
 			arg->v_pointer = sv_to_struct (transfer,