gnome-perl-introspection r32 - trunk/Glib-Object-Introspection/xs

[tsch svn gnome org]

Author: tsch
Date: Sat Nov  8 19:57:28 2008
New Revision: 32
URL: http://svn.gnome.org/viewvc/gnome-perl-introspection?rev=32&view=rev

Log:
Special-case the invocation of constructors in
Glib::Idl::FunctionInfo::invoke() so it doesn't have to be done further up in
the hierarchy.  Fix the marshalling of GError arguments.

Get rid of the handling of unresolved types; gobject-introspection takes care
of that now.  Treat boxed objects, structs, and unions equally for argument
marshalling.

Fix the callback argument handling.

Add optional debug spew.  Increase robustness in some places.


Modified:
   trunk/Glib-Object-Introspection/xs/IdlFunctionInfo.xs

Modified: trunk/Glib-Object-Introspection/xs/IdlFunctionInfo.xs
==============================================================================
--- trunk/Glib-Object-Introspection/xs/IdlFunctionInfo.xs	(original)
+++ trunk/Glib-Object-Introspection/xs/IdlFunctionInfo.xs	Sat Nov  8 19:57:28 2008
@@ -35,33 +35,21 @@
 
 /* ------------------------------------------------------------------------- */
 
-GType
-get_gtype_for_unresolved_type (const gchar *namespace, const gchar *name)
-{
-#if 0
-	GIBaseInfo *unresolved_info =
-		g_irepository_find_by_name (NULL, namespace, name);
-	return gperl_i11n_get_gtype (
-		(GIRegisteredTypeInfo *) unresolved_info);
-#else
-	gchar *full_name;
-	GType type;
-
-	if (0 == strcmp (namespace, "GLib"))
-		namespace = "G";
-	full_name = g_strconcat (namespace, name, NULL);
-	type = g_type_from_name (full_name);
-	g_free (full_name);
-
-	return type;
-#endif
-}
-
 void *
 gperl_i11n_sv_to_pointer (GITypeInfo* info, SV *sv)
 {
-	GIBaseInfo *interface = g_type_info_get_interface (info);
-	GIInfoType info_type = g_base_info_get_type (interface);
+	GIBaseInfo *interface;
+	GIInfoType info_type;
+
+	interface = g_type_info_get_interface (info);
+	if (!interface)
+		croak ("Could not convert sv %p to pointer", sv);
+	info_type = g_base_info_get_type (interface);
+
+#ifdef NOISY
+	warn ("    interface %p (%s) of type %d\n",
+	      interface, g_base_info_get_name (interface), info_type);
+#endif
 
 	void *pointer = NULL;
 
@@ -70,9 +58,18 @@
 		pointer = gperl_get_object (sv);
 		break;
 
+	    case GI_INFO_TYPE_UNION:
+	    case GI_INFO_TYPE_STRUCT:
 	    case GI_INFO_TYPE_BOXED:
 	    {
 		GType type = gperl_i11n_get_gtype ((GIRegisteredTypeInfo *) interface);
+		if (!type)
+			croak ("Could not find GType for boxed/struct/union type %s::%s",
+			       g_base_info_get_namespace (interface),
+			       g_base_info_get_name (interface));
+#ifdef NOISY
+		warn ("    gtype %s (%d)\n", g_type_name (type), type);
+#endif
 		pointer = gperl_get_boxed_check (sv, type);
 		break;
 	    }
@@ -93,57 +90,15 @@
 
 	    case GI_INFO_TYPE_CALLBACK:
 	    {
-		pointer = create_callback_closure (info, sv);
-		break;
-	    }
-
-	    case GI_INFO_TYPE_UNRESOLVED:
-	    {
-		const gchar *type_name, *type_namespace;
-		GType type;
-
-		type_name = g_base_info_get_name (interface);
-		type_namespace = g_base_info_get_namespace (interface);
-
-		/* FIXME: The following special casing feels very hackish.
-		 * Find a better solution. */
-
-		if (0 == strncmp (type_namespace, "GLib", 5)) {
-			/* Handle callback stuff first */
-			if (0 == strncmp (type_name, "CallbackData", 13)) {
-				pointer = create_callback_data (sv);
-				break;
-			}
-
-			if (0 == strncmp (type_name, "DestroyNotify", 14)) {
-				pointer = release_callback;
-				break;
-			}
-
-			/* Then, handle GType. */
-			if (0 == strncmp (type_name, "Type", 5)) {
-				pointer = (void *) gperl_type_from_package (SvPV_nolen (sv));
-				break;
-			}
+		const gchar *type_name = g_base_info_get_name (interface);
+		/* FIXME: this is a hack */
+		if (0 == strncmp (type_name, "DestroyNotify", 14)) {
+			warn ("FIXME: callback of name DestroyNotify "
+			      "interpreted as destroy notify thingy");
+			pointer = release_callback;
+		} else {
+			pointer = create_callback_closure (info, sv);
 		}
-
-		type = get_gtype_for_unresolved_type (type_namespace, type_name);
-		if (!type)
-			croak ("Could not determine type for %s", type_name);
-
-		if (g_type_is_a (type, G_TYPE_OBJECT))
-			pointer = gperl_get_object (sv);
-
-		else if (g_type_is_a (type, G_TYPE_BOXED))
-			pointer = gperl_get_boxed_check (sv, type);
-
-		else if (g_type_is_a (type, G_TYPE_ENUM))
-			pointer = GINT_TO_POINTER (gperl_convert_enum (type, sv));
-
-		else
-			croak ("Don't know how to handle type %d (%s)",
-			       type, type_name);
-
 		break;
 	    }
 
@@ -159,8 +114,13 @@
 SV *
 gperl_i11n_pointer_to_sv (GITypeInfo* info, void* pointer, gboolean own)
 {
-	GIBaseInfo *interface = g_type_info_get_interface (info);
-	GIInfoType info_type = g_base_info_get_type (interface);
+	GIBaseInfo *interface;
+	GIInfoType info_type;
+
+	interface = g_type_info_get_interface (info);
+	if (!interface)
+		croak ("Could not convert pointer %p to SV", pointer);
+	info_type = g_base_info_get_type (interface);
 
 	SV *sv = NULL;
 
@@ -169,9 +129,15 @@
 		sv = gperl_new_object (pointer, own);
 		break;
 
+	    case GI_INFO_TYPE_UNION:
+	    case GI_INFO_TYPE_STRUCT:
 	    case GI_INFO_TYPE_BOXED:
 	    {
 		GType type = gperl_i11n_get_gtype ((GIRegisteredTypeInfo *) interface);
+		if (!type)
+			croak ("Could not find GType for boxed/struct/union type %s::%s",
+			       g_base_info_get_namespace (interface),
+			       g_base_info_get_name (interface));
 		sv = gperl_new_boxed (pointer, type, own);
 		break;
 	    }
@@ -190,33 +156,8 @@
 		break;
 	    }
 
-	    case GI_INFO_TYPE_UNRESOLVED:
-	    {
-		const gchar *type_name = g_base_info_get_name (interface);
-		const gchar *type_namespace = g_base_info_get_namespace (interface);
-		GType type = get_gtype_for_unresolved_type (type_namespace, type_name);
-
-		if (!type)
-			croak ("Could not determine type for %s", type_name);
-
-		if (g_type_is_a (type, G_TYPE_OBJECT))
-			sv = gperl_new_object (pointer, own);
-
-		else if (g_type_is_a (type, G_TYPE_BOXED))
-			sv = gperl_new_boxed (pointer, type, own);
-
-		else if (g_type_is_a (type, G_TYPE_ENUM))
-			sv = gperl_convert_back_enum (type, GPOINTER_TO_INT (pointer));
-
-		else
-			croak ("Don't know how to handle type %d (%s)",
-			       type, type_name);
-
-		break;
-	    }
-
 	    default:
-		croak ("gperl_i11n_pointer_to_sv: Don't know how to handle info type %d, %d", info_type, GI_INFO_TYPE_ENUM);
+		croak ("gperl_i11n_pointer_to_sv: Don't know how to handle info type %d", info_type);
 	}
 
 	g_base_info_unref ((GIBaseInfo *) interface);
@@ -235,7 +176,7 @@
 	GIInfoType info_type = g_base_info_get_type (container);
 
 #ifdef NOISY
-	warn ("instance_sv_to_pointer: container name: %s, info type: %d",
+	warn ("  instance_sv_to_pointer: container name: %s, info type: %d\n",
 	      g_base_info_get_name (container),
 	      info_type);
 #endif
@@ -245,6 +186,9 @@
 	switch (info_type) {
 	    case GI_INFO_TYPE_OBJECT:
 		pointer = gperl_get_object (sv);
+#ifdef NOISY
+		warn ("    -> object pointer: %p\n", pointer);
+#endif
 		break;
 
 	    case GI_INFO_TYPE_BOXED:
@@ -252,6 +196,9 @@
 		GType type = gperl_i11n_get_gtype (
 			       (GIRegisteredTypeInfo *) container);
 		pointer = gperl_get_boxed_check (sv, type);
+#ifdef NOISY
+		warn ("    -> boxed pointer: %p\n", pointer);
+#endif
 		break;
 	    }
 
@@ -260,7 +207,7 @@
 	    case GI_INFO_TYPE_CALLBACK:
 	    case GI_INFO_TYPE_UNRESOLVED:
 	    default:
-		croak ("instance_sv_to_pointer: Don't know how to handle info type %d", info_type);
+		croak ("Don't know how to handle info type %d", info_type);
 	}
 
 	return pointer;
@@ -283,7 +230,12 @@
 
 	switch (tag) {
 	    case GI_TYPE_TAG_VOID:
-		/* do nothing */
+#ifdef NOISY
+		warn ("    type %p -> void pointer\n", info);
+#endif
+		warn ("FIXME: void pointer interpreted as callback user data");
+		/* FIXME: this is a hack */
+		arg->v_pointer = create_callback_data (sv);
 		break;
 
 	    case GI_TYPE_TAG_BOOLEAN:
@@ -351,6 +303,9 @@
 		break;
 
 	    case GI_TYPE_TAG_INTERFACE:
+#ifdef NOISY
+		warn ("    type %p -> interface\n", info);
+#endif
 		arg->v_pointer = gperl_i11n_sv_to_pointer (info, sv);
 		break;
 
@@ -1136,12 +1091,13 @@
 
     {
 	GIFunctionInfo * info = SvGIFunctionInfo (ST(0));
+	int stack_offset = 1;
 
 	ffi_cif cif;
 	ffi_type **arg_types = NULL;
 	ffi_type *return_type_ffi = NULL;
 	gpointer *args = NULL;
-	gpointer func_pointer = NULL;
+	gpointer func_pointer = NULL, instance = NULL;
 	const gchar *symbol = NULL;
 
 	int have_args;
@@ -1151,11 +1107,12 @@
 	int i, out_i;
 	GITypeInfo ** out_arg_type = NULL;
 	GITypeInfo * return_type_info = NULL;
-	gboolean throws, is_method, has_return_value;
+	gboolean throws, is_constructor, is_method, has_return_value;
 	GArgument return_value;
 	GArgument * in_args = NULL;
 	GArgument * out_args = NULL;
 	GError * local_error = NULL;
+	gpointer local_error_address = &local_error;
 
 	symbol = g_function_info_get_symbol (info);
 
@@ -1165,8 +1122,13 @@
 		croak ("Could not locate symbol %s", symbol);
 	}
 
-#define OFFSET 1
-	have_args = items - OFFSET;
+	is_constructor =
+		g_function_info_get_flags (info) & GI_FUNCTION_IS_CONSTRUCTOR;
+	if (is_constructor) {
+		stack_offset++;
+	}
+
+	have_args = items - stack_offset;
 
 	n_invoke_args = n_args = g_callable_info_get_n_args ((GICallableInfo *) info);
 
@@ -1177,7 +1139,7 @@
 
 	is_method =
 		(g_function_info_get_flags (info) & GI_FUNCTION_IS_METHOD)
-	    && !(g_function_info_get_flags (info) & GI_FUNCTION_IS_CONSTRUCTOR);
+	    && !is_constructor;
 	if (is_method) {
 		n_invoke_args++;
 	}
@@ -1203,14 +1165,15 @@
 	n_in_args = n_out_args = 0;
 
 	if (is_method) {
-		gpointer instance = instance_sv_to_pointer (info, ST (0+OFFSET));
+		instance = instance_sv_to_pointer (info, ST (0 + stack_offset));
 		arg_types[0] = &ffi_type_pointer;
 		args[0] = &instance;
 		n_in_args++;
 	}
 
+	int method_offset = is_method ? 1 : 0;
+
 	for (i = 0 ; i < n_args ; i++) {
-		int method_offset = is_method ? 1 : 0;
 		GIArgInfo * arg_info =
 			g_callable_info_get_arg ((GICallableInfo *) info, i);
 		/* In case of out and in-out args, arg_type is unref'ed after
@@ -1219,12 +1182,16 @@
 		gboolean may_be_null = g_arg_info_may_be_null (arg_info);
 
 #ifdef NOISY
-		warn ("  arg tag: %d\n", g_type_info_get_tag (arg_type));
+		{
+		GITypeTag arg_type_tag = g_type_info_get_tag (arg_type);
+		warn ("  arg tag: %s (%d)\n",
+		      g_type_tag_to_string (arg_type_tag), arg_type_tag);
+		}
 #endif
 
 		switch (g_arg_info_get_direction (arg_info)) {
 		    case GI_DIRECTION_IN:
-			sv_to_arg (ST (i + method_offset + OFFSET), &in_args[n_in_args], arg_type, may_be_null);
+			sv_to_arg (ST (i + method_offset + stack_offset), &in_args[n_in_args], arg_type, may_be_null);
 			arg_types[i + method_offset] = get_ffi_type (arg_type);
 			args[i + method_offset] = &in_args[n_in_args];
 			g_base_info_unref ((GIBaseInfo *) arg_type);
@@ -1242,7 +1209,7 @@
 		    {
 			GArgument * temp =
 				gperl_alloc_temp (sizeof (GArgument));
-			sv_to_arg (ST (i + method_offset + OFFSET), temp, arg_type, may_be_null);
+			sv_to_arg (ST (i + method_offset + stack_offset), temp, arg_type, may_be_null);
 			in_args[n_in_args].v_pointer =
 				out_args[n_out_args].v_pointer =
 					temp;
@@ -1257,7 +1224,6 @@
 
 		g_base_info_unref ((GIBaseInfo *) arg_info);
 	}
-#undef OFFSET
 
 #if 0
 	/*
@@ -1269,8 +1235,7 @@
 #endif
 
 	if (throws) {
-		gpointer address = &local_error;
-		args[n_invoke_args - 1] = &address;
+		args[n_invoke_args - 1] = &local_error_address;
 		arg_types[n_invoke_args - 1] = &ffi_type_pointer;
 	}