GNOME.org
 

[perl-Glib-Object-Introspection] Give error messages for invocations with too many or too few parameters

commit a56eb8c43d74c38119c4e3c9b5011465683281da
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sun Jan 13 22:45:14 2013 +0100

    Give error messages for invocations with too many or too few parameters

 GObjectIntrospection.xs     |   52 ++++++++++++++++++++-----------
 NEWS                        |    2 +
 gperl-i11n-croak.c          |   19 +++++++++++
 gperl-i11n-invoke-c.c       |   71 ++++++++++++++++++++++++++++++++++++-------
 gperl-i11n-invoke-info.c    |   33 +++++++++++++++++++-
 gperl-i11n-marshal-struct.c |    4 +-
 t/arg-checks.t              |   22 +++++++++++++
 7 files changed, 171 insertions(+), 32 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index b8b24d4..7fcc6ab 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -87,6 +87,9 @@ typedef struct {
  * communicate to each other. */
 typedef struct {
 	GICallableInfo *interface;
+	const gchar *target_package;
+	const gchar *target_namespace;
+	const gchar *target_function;
 
 	gboolean is_function;
 	gboolean is_vfunc;
@@ -95,6 +98,8 @@ typedef struct {
 
 	guint n_args;
 	guint n_invoke_args;
+	guint n_expected_args;
+	guint n_nullable_args;
 	guint n_given_args;
 	gboolean is_constructor;
 	gboolean is_method;
@@ -150,7 +155,10 @@ static void invoke_callback (ffi_cif* cif,
 static void invoke_callable (GICallableInfo *info,
                              gpointer func_pointer,
                              SV **sp, I32 ax, SV **mark, I32 items, /* these correspond to dXSARGS */
-                             UV internal_stack_offset);
+                             UV internal_stack_offset,
+                             const gchar *package,
+                             const gchar *namespace,
+                             const gchar *function);
 static gpointer allocate_out_mem (GITypeInfo *arg_type);
 static void handle_automatic_arg (guint pos,
                                   GIArgument * arg,
@@ -160,7 +168,10 @@ static void handle_automatic_arg (guint pos,
 static void prepare_c_invocation_info (GPerlI11nInvocationInfo *iinfo,
                                        GICallableInfo *info,
                                        IV items,
-                                       UV internal_stack_offset);
+                                       UV internal_stack_offset,
+                                       const gchar *package,
+                                       const gchar *namespace,
+                                       const gchar *function);
 static void clear_c_invocation_info (GPerlI11nInvocationInfo *iinfo);
 
 static void prepare_perl_invocation_info (GPerlI11nInvocationInfo *iinfo,
@@ -256,8 +267,10 @@ static void generic_interface_finalize (gpointer iface, gpointer data);
 static void generic_class_init (GIObjectInfo *info, const gchar *target_package, gpointer class);
 
 /* misc. */
-#define ccroak(...) call_carp_croak (form (__VA_ARGS__));
 static void call_carp_croak (const char *msg);
+static void call_carp_carp (const char *msg);
+#define ccroak(...) call_carp_croak (form (__VA_ARGS__));
+#define cwarn(...) call_carp_carp (form (__VA_ARGS__));
 
 /* interface_to_sv and its callers might invoke Perl code, so any xsub invoking
  * them needs to save the stack.  this wrapper does this automatically. */
@@ -477,8 +490,8 @@ _register_boxed_synonym (class, const gchar *reg_basename, const gchar *reg_name
 	reg_info = g_irepository_find_by_name (repository, reg_basename, reg_name);
 	reg_type = reg_info ? get_gtype (reg_info) : 0;
 	if (!reg_type)
-		croak ("Could not lookup GType for type %s.%s",
-		       reg_basename, reg_name);
+		ccroak ("Could not lookup GType for type %s.%s",
+		        reg_basename, reg_name);
 
 	/* The GType in question (e.g., GdkRectangle) hasn't been loaded yet,
 	 * so we cannot use g_type_name.  It's also absent from the typelib, so
@@ -490,8 +503,8 @@ _register_boxed_synonym (class, const gchar *reg_basename, const gchar *reg_name
 	syn_type = syn_gtype_function_pointer ? syn_gtype_function_pointer () : 0;
 	g_module_close (module);
 	if (!syn_type)
-		croak ("Could not lookup GType from function %s",
-		       syn_gtype_function);
+		ccroak ("Could not lookup GType from function %s",
+		        syn_gtype_function);
 
 	dwarn ("registering synonym %s => %s",
 	       g_type_name (reg_type),
@@ -783,7 +796,8 @@ _invoke_fallback_vfunc (class, vfunc_package, vfunc_name, target_package, ...)
 	g_assert (func_pointer);
 	invoke_callable (vfunc_info, func_pointer,
 	                 sp, ax, mark, items,
-	                 internal_stack_offset);
+	                 internal_stack_offset,
+	                 NULL, NULL, NULL);
 	/* SPAGAIN since invoke_callable probably modified the stack
 	 * pointer.  so we need to make sure that our local variable
 	 * 'sp' is correct before the implicit PUTBACK happens. */
@@ -807,23 +821,23 @@ _use_generic_signal_marshaller_for (class, const gchar *package, const gchar *si
 
 	gtype = gperl_type_from_package (package);
 	if (!gtype)
-		croak ("Could not find GType for package %s", package);
+		ccroak ("Could not find GType for package %s", package);
 
 	repository = g_irepository_get_default ();
 	container_info = g_irepository_find_by_gtype (repository, gtype);
 	if (!container_info ||
 	    !(GI_IS_OBJECT_INFO (container_info) ||
 	      GI_IS_INTERFACE_INFO (container_info)))
-		croak ("Could not find object/interface info for package %s",
-		       package);
+		ccroak ("Could not find object/interface info for package %s",
+		        package);
 
 	signal_info = g_new0 (GPerlI11nPerlSignalInfo, 1); // FIXME: ctor?
 	signal_info->interface = get_signal_info (container_info, signal);
 	if (args_converter)
 		signal_info->args_converter = SvREFCNT_inc (args_converter);
 	if (!signal_info)
-		croak ("Could not find signal %s for package %s",
-		       signal, package);
+		ccroak ("Could not find signal %s for package %s",
+		        signal, package);
 
 	closure_marshal_info = g_irepository_find_by_name (repository,
 		                                           "GObject",
@@ -872,10 +886,10 @@ _use_generic_signal_marshaller_for (class, const gchar *package, const gchar *si
 #endif
 
 void
-invoke (class, basename, namespace, method, ...)
+invoke (class, basename, namespace, function, ...)
 	const gchar *basename
 	const gchar_ornull *namespace
-	const gchar *method
+	const gchar *function
     PREINIT:
 	UV internal_stack_offset = 4;
 	GIRepository *repository;
@@ -884,7 +898,7 @@ invoke (class, basename, namespace, method, ...)
 	const gchar *symbol = NULL;
     PPCODE:
 	repository = g_irepository_get_default ();
-	info = get_function_info (repository, basename, namespace, method);
+	info = get_function_info (repository, basename, namespace, function);
 	symbol = g_function_info_get_symbol (info);
 	if (!g_typelib_symbol (g_base_info_get_typelib((GIBaseInfo *) info),
 			       symbol, &func_pointer))
@@ -893,7 +907,8 @@ invoke (class, basename, namespace, method, ...)
 	}
 	invoke_callable (info, func_pointer,
 	                 sp, ax, mark, items,
-	                 internal_stack_offset);
+	                 internal_stack_offset,
+	                 get_package_for_basename (basename), namespace, function);
 	/* SPAGAIN since invoke_callable probably modified the stack pointer.
 	 * so we need to make sure that our implicit local variable 'sp' is
 	 * correct before the implicit PUTBACK happens. */
@@ -944,7 +959,8 @@ _invoke (SV *code, ...)
 		ccroak ("invalid reference encountered");
 	invoke_callable (wrapper->interface, wrapper->func,
 	                 sp, ax, mark, items,
-	                 internal_stack_offset);
+	                 internal_stack_offset,
+	                 NULL, NULL, NULL);
 
 void
 DESTROY (SV *code)
diff --git a/NEWS b/NEWS
index 5cf92fb..4fc3d1c 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@ Overview of changes in Glib::Object::Introspection <next>
 ========================================================
 
 * Implement generic signal marshalling.
+* Generate error messages when function are passed an incorrect number of
+  parameters.
 * Avoid using vfunc names that coincide with special Perl subs.  This fixes
   double-frees occurring for subclasses of Gtk3::Widget.
 * Correctly marshal in-out args when invoking Perl code.
diff --git a/gperl-i11n-croak.c b/gperl-i11n-croak.c
index c7016e6..33b0ed8 100644
--- a/gperl-i11n-croak.c
+++ b/gperl-i11n-croak.c
@@ -20,3 +20,22 @@ call_carp_croak (const char *msg)
 	FREETMPS;
 	LEAVE;
 }
+
+/* Similarly for Carp's carp(). */
+static void
+call_carp_carp (const char *msg)
+{
+	dSP;
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK (SP);
+	XPUSHs (sv_2mortal (newSVpv(msg, PL_na)));
+	PUTBACK;
+
+	call_pv("Carp::carp", G_VOID | G_DISCARD);
+
+	FREETMPS;
+	LEAVE;
+}
diff --git a/gperl-i11n-invoke-c.c b/gperl-i11n-invoke-c.c
index bdced7e..154601e 100644
--- a/gperl-i11n-invoke-c.c
+++ b/gperl-i11n-invoke-c.c
@@ -1,10 +1,57 @@
 /* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
 
+static gchar *
+format_target (GPerlI11nInvocationInfo *iinfo)
+{
+	gchar *caller = NULL;
+	if (iinfo->target_package && iinfo->target_namespace && iinfo->target_function) {
+		caller = g_strconcat (iinfo->target_package, "::",
+		                      iinfo->target_namespace, "::",
+		                      iinfo->target_function,
+		                      NULL);
+	} else if (iinfo->target_package && iinfo->target_function) {
+		caller = g_strconcat (iinfo->target_package, "::",
+		                      iinfo->target_function,
+		                      NULL);
+	} else {
+		caller = g_strconcat ("Callable ",
+		                      g_base_info_get_name (iinfo->interface),
+		                      NULL);
+	}
+	return caller;
+}
+
+static void
+check_n_args (GPerlI11nInvocationInfo *iinfo)
+{
+	if (iinfo->n_expected_args != iinfo->n_given_args) {
+		/* Avoid the cost of formatting the target until we know we
+		 * need it. */
+		gchar *caller = NULL;
+		if (iinfo->n_given_args < (iinfo->n_expected_args - iinfo->n_nullable_args)) {
+			caller = format_target (iinfo);
+			ccroak ("%s: passed too few parameters "
+			        "(expected %d, got %d)",
+			        caller, iinfo->n_expected_args, iinfo->n_given_args);
+		} else if (iinfo->n_given_args > iinfo->n_expected_args) {
+			caller = format_target (iinfo);
+			cwarn ("*** %s: passed too many parameters "
+			       "(expected %d, got %d); ignoring excess",
+			       caller, iinfo->n_expected_args, iinfo->n_given_args);
+		}
+		if (caller)
+			g_free (caller);
+	}
+}
+
 static void
 invoke_callable (GICallableInfo *info,
                  gpointer func_pointer,
                  SV **sp, I32 ax, SV **mark, I32 items, /* these correspond to dXSARGS */
-                 UV internal_stack_offset)
+                 UV internal_stack_offset,
+                 const gchar *package,
+                 const gchar *namespace,
+                 const gchar *function)
 {
 	ffi_cif cif;
 	gpointer instance = NULL;
@@ -17,7 +64,10 @@ invoke_callable (GICallableInfo *info,
 
 	PERL_UNUSED_VAR (mark);
 
-	prepare_c_invocation_info (&iinfo, info, items, internal_stack_offset);
+	prepare_c_invocation_info (&iinfo, info, items, internal_stack_offset,
+	                           package, namespace, function);
+
+	check_n_args (&iinfo);
 
 	if (iinfo.is_method) {
 		instance = instance_sv_to_pointer (info, ST (0 + iinfo.stack_offset));
@@ -29,7 +79,7 @@ invoke_callable (GICallableInfo *info,
 		GIArgInfo * arg_info;
 		GITypeInfo * arg_type;
 		GITransfer transfer;
-		gboolean may_be_null;
+		gboolean may_be_null = FALSE, is_skipped = FALSE;
 		gint perl_stack_pos, ffi_stack_pos;
 		SV *current_sv;
 
@@ -39,6 +89,9 @@ invoke_callable (GICallableInfo *info,
 		arg_type = g_arg_info_get_type (arg_info);
 		transfer = g_arg_info_get_ownership_transfer (arg_info);
 		may_be_null = g_arg_info_may_be_null (arg_info);
+#if GI_CHECK_VERSION (1, 29, 0)
+		is_skipped = g_arg_info_is_skip (arg_info);
+#endif
 		perl_stack_pos = i
                                + iinfo.method_offset
                                + iinfo.stack_offset
@@ -60,18 +113,16 @@ invoke_callable (GICallableInfo *info,
 		       g_type_info_is_pointer (arg_type),
 		       iinfo.is_automatic_arg[i]);
 
-		/* FIXME: Generate a proper usage message if the user did not
-		 * supply enough arguments. */
+		/* Use undef for missing args (due to the checks above, these
+		 * must be nullable). */
 		current_sv = perl_stack_pos < items ? ST (perl_stack_pos) : &PL_sv_undef;
 
 		switch (g_arg_info_get_direction (arg_info)) {
 		    case GI_DIRECTION_IN:
 			if (iinfo.is_automatic_arg[i]) {
 				iinfo.dynamic_stack_offset--;
-#if GI_CHECK_VERSION (1, 29, 0)
-			} else if (g_arg_info_is_skip (arg_info)) {
+			} else if (is_skipped) {
 				iinfo.dynamic_stack_offset--;
-#endif
 			} else {
 				sv_to_arg (current_sv,
 				           &iinfo.in_args[i], arg_info, arg_type,
@@ -106,10 +157,8 @@ invoke_callable (GICallableInfo *info,
 					&iinfo.aux_args[i];
 			if (iinfo.is_automatic_arg[i]) {
 				iinfo.dynamic_stack_offset--;
-#if GI_CHECK_VERSION (1, 29, 0)
-			} else if (g_arg_info_is_skip (arg_info)) {
+			} else if (is_skipped) {
 				iinfo.dynamic_stack_offset--;
-#endif
 			} else {
 				/* We pass iinfo.in_args[i].v_pointer here,
 				 * not &iinfo.in_args[i], so that the value
diff --git a/gperl-i11n-invoke-info.c b/gperl-i11n-invoke-info.c
index c0e7693..7fbad7e 100644
--- a/gperl-i11n-invoke-info.c
+++ b/gperl-i11n-invoke-info.c
@@ -4,7 +4,10 @@ static void
 prepare_c_invocation_info (GPerlI11nInvocationInfo *iinfo,
                            GICallableInfo *info,
                            IV items,
-                           UV internal_stack_offset)
+                           UV internal_stack_offset,
+                           const gchar *package,
+                           const gchar *namespace,
+                           const gchar *function)
 {
 	guint i;
 
@@ -14,6 +17,9 @@ prepare_c_invocation_info (GPerlI11nInvocationInfo *iinfo,
 	       g_callable_info_get_n_args (info));
 
 	iinfo->interface = info;
+	iinfo->target_package = package;
+	iinfo->target_namespace = namespace;
+	iinfo->target_function = function;
 
 	iinfo->is_function = GI_IS_FUNCTION_INFO (info);
 	iinfo->is_vfunc = GI_IS_VFUNC_INFO (info);
@@ -124,6 +130,31 @@ prepare_c_invocation_info (GPerlI11nInvocationInfo *iinfo,
 		g_base_info_unref ((GIBaseInfo *) arg_info);
 	}
 
+	/* Make another pass to count the expected args. */
+	iinfo->n_expected_args = iinfo->method_offset;
+	iinfo->n_nullable_args = 0;
+	for (i = 0 ; i < iinfo->n_args ; i++) {
+		GIArgInfo * arg_info =
+			g_callable_info_get_arg ((GICallableInfo *) info, i);
+		GITypeInfo * arg_type = g_arg_info_get_type (arg_info);
+		GITypeTag arg_tag = g_type_info_get_tag (arg_type);
+		gboolean is_out = GI_DIRECTION_OUT == g_arg_info_get_direction (arg_info);
+		gboolean is_automatic = iinfo->is_automatic_arg[i];
+		gboolean is_skipped = FALSE;
+#if GI_CHECK_VERSION (1, 29, 0)
+		is_skipped = g_arg_info_is_skip (arg_info);
+#endif
+
+		if (!is_out && !is_automatic && !is_skipped)
+			iinfo->n_expected_args++;
+		/* Callback user data may always be NULL. */
+		if (g_arg_info_may_be_null (arg_info) || arg_tag == GI_TYPE_TAG_VOID)
+			iinfo->n_nullable_args++;
+
+		g_base_info_unref ((GIBaseInfo *) arg_type);
+		g_base_info_unref ((GIBaseInfo *) arg_info);
+	}
+
 	/* If the return value is an array which comes with an outbound length
 	 * arg, then mark that length arg as automatic, too. */
 	if (g_type_info_get_tag (iinfo->return_type_info) == GI_TYPE_TAG_ARRAY) {
diff --git a/gperl-i11n-marshal-struct.c b/gperl-i11n-marshal-struct.c
index 3f1f3cb..1815bfc 100644
--- a/gperl-i11n-marshal-struct.c
+++ b/gperl-i11n-marshal-struct.c
@@ -113,8 +113,8 @@ sv_to_struct (GITransfer transfer,
 		dwarn ("  disguised struct\n");
 		package = get_struct_package (info);
 		if (!gperl_sv_is_ref (sv) || !sv_derived_from (sv, package))
-			croak("Cannot convert scalar %p to an object of type %s",
-			      sv, package);
+			ccroak ("Cannot convert scalar %p to an object of type %s",
+			        sv, package);
 		g_free (package);
 		return INT2PTR (void *, SvIV ((SV *) SvRV (sv)));
 	}
diff --git a/t/arg-checks.t b/t/arg-checks.t
new file mode 100644
index 0000000..e9955c9
--- /dev/null
+++ b/t/arg-checks.t
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+
+BEGIN { require './t/inc/setup.pl' };
+
+use strict;
+use warnings;
+
+plan tests => 5;
+
+{
+  is (Regress::test_int8 (-127), -127);
+}
+
+{
+  is (eval { Regress::test_int8 () }, undef);
+  like ($@, qr/too few/);
+}
+
+{
+  local $SIG{__WARN__} = sub { like ($_[0], qr/too many/) };
+  is (Regress::test_int8 (127, 'bla'), 127);
+}
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]