[perl-Glib-Object-Introspection] When looking up GTypes, also try by name

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

commit 305dcae542c95c4b1909b41249261a8d3c2b5087
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sun Apr 1 17:17:00 2012 +0200

    When looking up GTypes, also try by name
    
    Some registered types (like many enums/flags in GObject) don't come with
    a GType.  For a few of those, Glib registers a GType (e.g.,
    GConnectFlags).  To find these, we need to try by name.

 GObjectIntrospection.xs        |   16 +++++++---------
 NEWS                           |   15 ++++++++++-----
 gperl-i11n-info.c              |   27 +++++++++++++++++++++++++++
 gperl-i11n-invoke-info.c       |    6 +++---
 gperl-i11n-marshal-interface.c |   17 +++++++----------
 gperl-i11n-size.c              |    2 +-
 6 files changed, 55 insertions(+), 28 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index a083e69..cef1c62 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -150,6 +150,8 @@ static GIFunctionInfo * get_function_info (GIRepository *repository,
                                            const gchar *method);
 static GIFieldInfo * get_field_info (GIBaseInfo *info,
                                      const gchar *field_name);
+static GType get_gtype (GIRegisteredTypeInfo *info);
+
 
 /* marshallers */
 static SV * interface_to_sv (GITypeInfo* info,
@@ -355,8 +357,7 @@ _register_types (class, namespace, package)
 			store_vfuncs (objects_with_vfuncs, info);
 		}
 
-		type = g_registered_type_info_get_g_type (
-			(GIRegisteredTypeInfo *) info);
+		type = get_gtype ((GIRegisteredTypeInfo *) info);
 		if (!type) {
 			ccroak ("Could not find GType for type %s::%s",
 			       namespace, name);
@@ -453,7 +454,7 @@ _get_field (class, basename, namespace, field, invocant)
 	if (!field_info)
 		ccroak ("Could not find field '%s' in namespace '%s'",
 		        field, namespace)
-	invocant_type = g_registered_type_info_get_g_type (namespace_info);
+	invocant_type = get_gtype (namespace_info);
 	if (!g_type_is_a (invocant_type, G_TYPE_BOXED))
 		ccroak ("Unable to handle field access for type '%s'",
 		        g_type_name (invocant_type));
@@ -487,7 +488,7 @@ _set_field (class, basename, namespace, field, invocant, new_value)
 	if (!field_info)
 		ccroak ("Could not find field '%s' in namespace '%s'",
 		        field, namespace)
-	invocant_type = g_registered_type_info_get_g_type (namespace_info);
+	invocant_type = get_gtype (namespace_info);
 	if (!g_type_is_a (invocant_type, G_TYPE_BOXED))
 		ccroak ("Unable to handle field access for type '%s'",
 		        g_type_name (invocant_type));
@@ -525,9 +526,7 @@ _add_interface (class, basename, interface_name, target_package)
 	if (!gtype)
 		ccroak ("package '%s' is not registered with Glib-Perl",
 		        target_package);
-	g_type_add_interface_static (gtype,
-	                             g_registered_type_info_get_g_type (info),
-	                             &iface_info);
+	g_type_add_interface_static (gtype, get_gtype (info), &iface_info);
 	/* info is unref'd in generic_interface_finalize */
 
 void
@@ -573,7 +572,7 @@ _find_non_perl_parents (class, basename, object_name, target_package)
 	info = g_irepository_find_by_name (repository, basename, object_name);
 	g_assert (info && GI_IS_OBJECT_INFO (info));
 	gtype = gperl_object_type_from_package (target_package);
-	object_gtype = g_registered_type_info_get_g_type (info);
+	object_gtype = get_gtype (info);
 	/* find all non-Perl parents up to and including the object type */
 	while ((gtype = g_type_parent (gtype))) {
 		/* FIXME: we should export gperl_type_reg_quark from Glib */
@@ -758,7 +757,6 @@ _invoke (SV *code, ...)
 	invoke_callable (wrapper->interface, wrapper->func,
 	                 sp, ax, mark, items,
 	                 internal_stack_offset);
-	/* wrapper->func (cell_layout, cell, tree_model, iter, wrapper->data); */
 
 void
 DESTROY (SV *code)
diff --git a/NEWS b/NEWS
index cb22f66..5912d25 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,8 @@
+Overview of changes in Glib::Object::Introspection <next>
+========================================================
+
+* When looking up GTypes, also try by name.
+
 Overview of changes in Glib::Object::Introspection 0.007
 ========================================================
 
@@ -16,11 +21,11 @@ Overview of changes in Glib::Object::Introspection 0.006
 Overview of changes in Glib::Object::Introspection 0.005
 ========================================================
 
-* use the overloaded '==' operator directly when comparing flags
-* Make enums.t test more robust
-* implement check_gi_version
-* implement test skipping
-* updated FSF address in license blurbs
+* Use the overloaded '==' operator directly when comparing flags
+* Make t/enums.t more robust
+* Implement check_gi_version
+* Implement test skipping
+* Update FSF address in license blurbs
 
 Overview of changes in Glib::Object::Introspection 0.004
 ========================================================
diff --git a/gperl-i11n-info.c b/gperl-i11n-info.c
index b91d80a..d4fa498 100644
--- a/gperl-i11n-info.c
+++ b/gperl-i11n-info.c
@@ -111,3 +111,30 @@ get_field_info (GIBaseInfo *info, const gchar *field_name)
 	}
 	return NULL;
 }
+
+static GType
+get_gtype (GIRegisteredTypeInfo *info)
+{
+	GType gtype = g_registered_type_info_get_g_type (info);
+	if (gtype == G_TYPE_NONE) {
+		/* Fall back to the registered type name, and if that doesn't
+		 * work either, construct the full name and try that. */
+		const gchar *type_name = g_registered_type_info_get_type_name (info);
+		if (type_name) {
+			gtype = g_type_from_name (type_name);
+			return gtype ? gtype : G_TYPE_NONE;
+		} else {
+			gchar *full_name;
+			const gchar *namespace = g_base_info_get_namespace (info);
+			const gchar *name = g_base_info_get_name (info);
+			if (0 == strncmp (namespace, "GObject", 8)) {
+				namespace = "G";
+			}
+			full_name = g_strconcat (namespace, name, NULL);
+			gtype = g_type_from_name (full_name);
+			g_free (full_name);
+			return gtype ? gtype : G_TYPE_NONE;
+		}
+	}
+	return gtype;
+}
diff --git a/gperl-i11n-invoke-info.c b/gperl-i11n-invoke-info.c
index 86fb5ea..dcbff8e 100644
--- a/gperl-i11n-invoke-info.c
+++ b/gperl-i11n-invoke-info.c
@@ -63,7 +63,7 @@ prepare_c_invocation_info (GPerlI11nInvocationInfo *iinfo,
 	dwarn ("C invoke: %s\n"
 	       "  n_args: %d, n_invoke_args: %d, n_given_args: %d\n"
 	       "  is_constructor: %d, is_method: %d\n",
-	       is_vfunc ? g_base_info_get_name (info) : g_function_info_get_symbol (info),
+	       iinfo->is_vfunc ? g_base_info_get_name (info) : g_function_info_get_symbol (info),
 	       iinfo->n_args, iinfo->n_invoke_args, iinfo->n_given_args,
 	       iinfo->is_constructor, iinfo->is_method);
 
@@ -146,7 +146,7 @@ prepare_c_invocation_info (GPerlI11nInvocationInfo *iinfo,
 	{
 		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_is_a (get_gtype (interface),
 		                 G_TYPE_INITIALLY_UNOWNED))
 		{
 			iinfo->return_type_transfer = GI_TRANSFER_EVERYTHING;
@@ -214,7 +214,7 @@ prepare_perl_invocation_info (GPerlI11nInvocationInfo *iinfo,
 	{
 		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_is_a (get_gtype (interface),
 		                 G_TYPE_INITIALLY_UNOWNED))
 		{
 			iinfo->return_type_transfer = GI_TRANSFER_EVERYTHING;
diff --git a/gperl-i11n-marshal-interface.c b/gperl-i11n-marshal-interface.c
index 927c910..2dcca33 100644
--- a/gperl-i11n-marshal-interface.c
+++ b/gperl-i11n-marshal-interface.c
@@ -25,8 +25,7 @@ instance_sv_to_pointer (GICallableInfo *info, SV *sv)
 	    case GI_INFO_TYPE_STRUCT:
             case GI_INFO_TYPE_UNION:
 	    {
-		GType type = g_registered_type_info_get_g_type (
-			       (GIRegisteredTypeInfo *) container);
+		GType type = get_gtype ((GIRegisteredTypeInfo *) container);
 		if (!type || type == G_TYPE_NONE) {
 			dwarn ("    unboxed type\n");
 			pointer = sv_to_struct (GI_TRANSFER_NOTHING,
@@ -88,8 +87,7 @@ sv_to_interface (GIArgInfo * arg_info,
 		gboolean need_value_semantics =
 			arg_info && g_arg_info_is_caller_allocates (arg_info)
 			&& !g_type_info_is_pointer (type_info);
-		GType type = g_registered_type_info_get_g_type (
-		               (GIRegisteredTypeInfo *) interface);
+		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
 		if (!type || type == G_TYPE_NONE) {
 			dwarn ("    unboxed type\n");
 			g_assert (!need_value_semantics);
@@ -132,7 +130,7 @@ sv_to_interface (GIArgInfo * arg_info,
 
 	    case GI_INFO_TYPE_ENUM:
 	    {
-		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
 		/* FIXME: Check storage type? */
 		arg->v_long = gperl_convert_enum (type, sv);
 		break;
@@ -140,7 +138,7 @@ sv_to_interface (GIArgInfo * arg_info,
 
 	    case GI_INFO_TYPE_FLAGS:
 	    {
-		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
 		/* FIXME: Check storage type? */
 		arg->v_long = gperl_convert_flags (type, sv);
 		break;
@@ -188,8 +186,7 @@ interface_to_sv (GITypeInfo* info, GIArgument *arg, gboolean own, GPerlI11nInvoc
 	    {
 		/* FIXME: What about pass-by-value here? */
 		GType type;
-		type = g_registered_type_info_get_g_type (
-		               (GIRegisteredTypeInfo *) interface);
+		type = get_gtype ((GIRegisteredTypeInfo *) interface);
 		if (!type || type == G_TYPE_NONE) {
 			dwarn ("    unboxed type\n");
 			sv = struct_to_sv (interface, info_type, arg->v_pointer, own);
@@ -207,7 +204,7 @@ interface_to_sv (GITypeInfo* info, GIArgument *arg, gboolean own, GPerlI11nInvoc
 
 	    case GI_INFO_TYPE_ENUM:
 	    {
-		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
 		/* FIXME: Is it right to just use v_long here? */
 		sv = gperl_convert_back_enum (type, arg->v_long);
 		break;
@@ -215,7 +212,7 @@ interface_to_sv (GITypeInfo* info, GIArgument *arg, gboolean own, GPerlI11nInvoc
 
 	    case GI_INFO_TYPE_FLAGS:
 	    {
-		GType type = g_registered_type_info_get_g_type ((GIRegisteredTypeInfo *) interface);
+		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
 		/* FIXME: Is it right to just use v_long here? */
 		sv = gperl_convert_back_flags (type, arg->v_long);
 		break;
diff --git a/gperl-i11n-size.c b/gperl-i11n-size.c
index 0845f49..fa5ed1b 100644
--- a/gperl-i11n-size.c
+++ b/gperl-i11n-size.c
@@ -65,7 +65,7 @@ size_of_interface (GITypeInfo *type_info)
 			/* FIXME: Remove this workaround once
 			 * gobject-introspection is fixed:
 			 * <https://bugzilla.gnome.org/show_bug.cgi?id=657040>. */
-			GType type = g_registered_type_info_get_g_type (info);
+			GType type = get_gtype (info);
 			if (type == G_TYPE_VALUE) {
 				size = sizeof (GValue);
 			} else {