Re: default signal closure via bindingset

[Torsten Schoenfeld <kaffeetisch gmx de>]

[In all the messages in this thread, s/G_TYPE_NONE/G_TYPE_INVALID/g.]

Kevin Ryde wrote:
> > We're supposed to do all the
> > type registration when loading the module, before any code using the
> > things gets called.
>
> It's not possible for a new fundamental type to exist without the
> registration?

It's conceivable, but in that case gperl_value_to_sv will croak anyway.  But 
still, avoiding the GHashTable assertion seems like a good idea to me.

> > That sounds like it could be a problem.  We use the presence of a
> > return value pointer to determine whether we're supposed to expect any
> > return values, but here they've passed ...  *brane asplode*
>
> The g_signal_chain_from_overridden in GSignal.xs looks suspiciously like
> it may do the same return_value typed as G_TYPE_NONE ...
>
> >         if (return_value) {
> >                 /* Try to cover for people doing strange things */
> >                 if (G_TYPE_NONE == G_VALUE_TYPE (return_value))
> >                         return_value = NULL;
>
> A good way to get G_DISCARD.  That'd be for both
> gperl_signal_class_closure_marshal() and gperl_closure_marshal() would
> it?  There's no call for the two to differ is there?

I think I prefer Kevin's original approach (which is a copy of the approach 
taken in gperl_closure_marshal), because it avoids modifying an input parameter. 
 But on the other hand it's nice to have G_VOID|G_DISCARD because then 
wantarray() and friends will give the correct answer inside the callback and we 
don't need to care about POPing the stack.  gperl_callback_invoke does this.

So I committed the attached series of patches to trunk and the stable branch. 
Please scream if I screwed anything up.
Index: GType.xs
===================================================================
--- GType.xs    (revision 1077)
+++ GType.xs    (revision 1078)
@@ -273,10 +273,13 @@ registered with gperl_register_fundament
 GPerlValueWrapperClass *
 gperl_fundamental_wrapper_class_from_type (GType gtype)
 {
-       GPerlValueWrapperClass * res;
+       GPerlValueWrapperClass * res = NULL;
        G_LOCK (wrapper_class_by_type);
-       res = (GPerlValueWrapperClass *)
-               g_hash_table_lookup (wrapper_class_by_type, (gpointer) gtype);
+       if (wrapper_class_by_type) {
+               res = (GPerlValueWrapperClass *)
+                       g_hash_table_lookup (wrapper_class_by_type,
+                                            (gpointer) gtype);
+       }
        G_UNLOCK (wrapper_class_by_type);
        return res;
 }
Index: ChangeLog
===================================================================
--- ChangeLog   (revision 1077)
+++ ChangeLog   (revision 1078)
@@ -1,5 +1,10 @@
 2009-02-05  Torsten Schoenfeld  <kaffeetisch gmx de>
 
+       * GType.xs (gperl_register_fundamental_full): Handle
+       wrapper_class_by_type being NULL gracefully.  Patch by Kevin Ryde.
+
+2009-02-05  Torsten Schoenfeld  <kaffeetisch gmx de>
+
        * Glib.xs: In Glib::filename_from_uri and filename_to_uri, use the
        gchar converters for the hostname.  Patch by Kevin Ryde.
 

Index: MANIFEST
===================================================================
--- MANIFEST    (revision 1078)
+++ MANIFEST    (revision 1079)
@@ -62,6 +62,7 @@ t/lazy_loader.t
 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
Index: GType.xs
===================================================================
--- GType.xs    (revision 1078)
+++ GType.xs    (revision 1079)
@@ -983,6 +983,7 @@ gperl_signal_class_closure_marshal (GClo
        /* 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 @@ gperl_signal_class_closure_marshal (GClo
                /* 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;
                }
Index: ChangeLog
===================================================================
--- ChangeLog   (revision 1078)
+++ ChangeLog   (revision 1079)
@@ -1,5 +1,12 @@
 2009-02-05  Torsten Schoenfeld  <kaffeetisch gmx de>
 
+       * MANIFEST
+       * GType.xs (gperl_signal_class_closure_marshal)
+       * t/signal_marshal.t: Correctly handle signals with no return type
+       when invoking signal class closures.  Patch by Kevin Ryde.
+
+2009-02-05  Torsten Schoenfeld  <kaffeetisch gmx de>
+
        * GType.xs (gperl_register_fundamental_full): Handle
        wrapper_class_by_type being NULL gracefully.  Patch by Kevin Ryde.
 
Index: t/signal_marshal.t
===================================================================
--- t/signal_marshal.t  (revision 0)
+++ t/signal_marshal.t  (revision 1079)
@@ -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');

Index: ChangeLog
===================================================================
--- ChangeLog   (revision 1079)
+++ ChangeLog   (revision 1080)
@@ -1,5 +1,13 @@
 2009-02-05  Torsten Schoenfeld  <kaffeetisch gmx de>
 
+       * GClosure.xs (gperl_closure_marshal): Synchronize the way signals
+       with no return value are handled with how it's done in
+       gperl_signal_class_closure_marshal.  This means that Perl handlers
+       for these kinds of signals are now always called in void context,
+       as they should be.
+
+2009-02-05  Torsten Schoenfeld  <kaffeetisch gmx de>
+
        * MANIFEST
        * GType.xs (gperl_signal_class_closure_marshal)
        * t/signal_marshal.t: Correctly handle signals with no return type
Index: GClosure.xs
===================================================================
--- GClosure.xs (revision 1079)
+++ GClosure.xs (revision 1080)
@@ -69,6 +69,7 @@ gperl_closure_marshal (GClosure * closur
                       gpointer invocation_hint,
                       gpointer marshal_data)
 {
+       gboolean want_return_value;
        int flags;
        guint i;
        dGPERL_CLOSURE_MARSHAL_ARGS;
@@ -99,18 +100,15 @@ gperl_closure_marshal (GClosure * closur
 
        PUTBACK;
 
-       flags = return_value ? G_SCALAR : G_DISCARD;
+       want_return_value = return_value && G_VALUE_TYPE (return_value);
+       flags = want_return_value ? G_SCALAR : G_VOID|G_DISCARD;
 
        SPAGAIN;
 
        GPERL_CLOSURE_MARSHAL_CALL (flags);
 
-       if (return_value) {
-               /* we need to remove the value to from the stack,
-                * regardless of whether we do anything with it. */
-               SV * sv = POPs;
-               if (G_VALUE_TYPE (return_value))
-                       gperl_value_from_sv (return_value, sv);
+       if (want_return_value) {
+               gperl_value_from_sv (return_value, POPs);
                PUTBACK; /* vitally important */
        }