perl-Glib r1079 - in trunk: . t

[tsch svn gnome org]

Author: tsch
Date: Thu Feb  5 16:12:34 2009
New Revision: 1079
URL: http://svn.gnome.org/viewvc/perl-Glib?rev=1079&view=rev

Log:
(gperl_signal_class_closure_marshal): Correctly handle signals with no return
type when invoking signal class closures.  Patch by Kevin Ryde.


Added:
   trunk/t/signal_marshal.t
Modified:
   trunk/ChangeLog
   trunk/GType.xs
   trunk/MANIFEST

Modified: trunk/GType.xs
==============================================================================
--- trunk/GType.xs	(original)
+++ trunk/GType.xs	Thu Feb  5 16:12:34 2009
@@ -983,6 +983,7 @@
 	/* does the function exist? then call it. */
 	if (slot && GvCV (*slot)) {
 		SV * save_errsv;
+		gboolean want_return_value;
 		int flags;
 		dSP;
 
@@ -1007,13 +1008,14 @@
 		/* note: keep this as closely sync'ed as possible with the
 		 * definition of GPERL_CLOSURE_MARSHAL_CALL. */
 		save_errsv = sv_2mortal (newSVsv (ERRSV));
-		flags = G_EVAL | (return_value ? G_SCALAR : G_VOID|G_DISCARD);
+		want_return_value = return_value && G_VALUE_TYPE (return_value);
+		flags = G_EVAL | (want_return_value ? G_SCALAR : G_VOID|G_DISCARD);
 		call_method (SvPV_nolen (method_name), flags);
 		SPAGAIN;
 		if (SvTRUE (ERRSV)) {
 			gperl_run_exception_handlers ();
 
-		} else if (return_value) {
+		} else if (want_return_value) {
 			gperl_value_from_sv (return_value, POPs);
 			PUTBACK;
 		}

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	(original)
+++ trunk/MANIFEST	Thu Feb  5 16:12:34 2009
@@ -62,6 +62,7 @@
 t/make_helper.t
 t/options.t
 t/signal_emission_hooks.t
+t/signal_marshal.t
 t/signal_query.t
 t/tied_definedness.t
 TODO

Added: trunk/t/signal_marshal.t
==============================================================================
--- (empty file)
+++ trunk/t/signal_marshal.t	Thu Feb  5 16:12:34 2009
@@ -0,0 +1,54 @@
+#!perl
+package MyClass;
+use strict;
+use warnings;
+use Glib;
+
+use Glib::Object::Subclass
+  'Glib::Object',
+  signals => { mysig => { param_types => [],
+                          return_type => undef },
+             };
+
+sub INIT_INSTANCE {
+  my ($self) = @_;
+}
+
+sub do_mysig {
+  return 123;
+}
+
+
+package MySubClass;
+use strict;
+use warnings;
+use Glib;
+
+use Glib::Object::Subclass
+  'MyClass',
+  signals => { mysig => \&_do_mysubclass_mysig };
+
+sub INIT_INSTANCE {
+  my ($self) = @_;
+}
+
+our $MYSIG_RUNS = 0;
+
+sub _do_mysubclass_mysig {
+  my ($self) = @_;
+  $self->signal_chain_from_overridden;
+  $MYSIG_RUNS++;
+}
+
+
+package main;
+use strict;
+use warnings;
+use Glib;
+use Test::More tests => 1;
+
+my $obj = MySubClass->new;
+$obj->signal_emit ('mysig');
+
+is($MySubClass::MYSIG_RUNS, 1,
+   'marshaling a signal with no return type');