signal_connect bad name leak

[Kevin Ryde <user42 zip com au>]

Giving a bad signal name to signal_connect() seems to leak some memory.
Eg. core used by foo.pl below grows forever.

I know leaks on error conditions aren't a priority, but this one is easy
to notice.  I get some joy from inserting a g_closure_unref per below.
(That's the right way to discard a GClosure which still has a floating
ref, is it?)

use strict;
use warnings;
use Gtk2;
use POSIX;

POSIX::dup2(POSIX::open('/dev/null'), 2); # stderr to /dev/null

my $label = Gtk2::Label->new;
while (1) {
  $label->signal_connect ('nosuchsignal', \&noop);
}
sub noop {}

Index: GSignal.xs
===================================================================
--- GSignal.xs	(revision 1092)
+++ GSignal.xs	(working copy)
@@ -1,5 +1,5 @@
 /*
- * Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for
+ * Copyright (C) 2003-2004, 2009 by the gtk2-perl team (see the file AUTHORS for
  * the full list)
  *
  * This library is free software; you can redistribute it and/or modify it
@@ -270,6 +270,7 @@
 	GObject * object;
 	GPerlClosure * closure;
 	GClosureMarshal marshaller = NULL;
+	gulong id;
 
 	object = gperl_get_object (instance);
 
@@ -292,16 +293,19 @@
 			                      marshaller);
 
 	/* after is true only if we're called as signal_connect_after */
-	closure->id =
-		g_signal_connect_closure (object,
+	id =	g_signal_connect_closure (object,
 		                          detailed_signal,
 		                          (GClosure*) closure, 
 		                          flags & G_CONNECT_AFTER);
 
-	if (closure->id > 0)
+	if (id > 0) {
+		closure->id = id;
 		remember_closure (closure);
-	
-	return ((GPerlClosure*)closure)->id;
+	} else {
+		/* not connected, usually bad detailed_signal name */
+		g_closure_unref ((GClosure*) closure);
+	}
+	return id;
 }
 
 /*
Index: t/7.t
===================================================================
--- t/7.t	(revision 1092)
+++ t/7.t	(working copy)
@@ -21,7 +21,7 @@
 
 use Test::More import => ['diag'];
 
-print "1..34\n";
+print "1..36\n";
 
 sub ok($$;$) {
     my($test, $num, $name) = @_;
@@ -269,16 +269,38 @@
    $my->signal_connect_after (list_returner => sub { fail("shouldn't get here"); 0 });
    pass(27);
    print Dumper( $my->list_returner );
+
+
+   # Check that a signal_connect() of a non-existant signal name doesn't
+   # leak the subr passed to it, ie. doesn't keep it alive forever.
+   #
+   # Note $subr has to use $x or similar in its containing environment to be
+   # a closure.  If not then it's treated as part of the mainline code and
+   # won't be gc'ed immediately -- or something like that.
+   {
+     my $x = 123;
+     my $subr = sub { return $x };
+
+     # handler to suppress the warning message from nosuchsignal
+     my $logid = Glib::Log->set_handler ('GLib-GObject', ['warning'], sub { });
+     my $sigid = $my->signal_connect ('nosuchsignal' => $subr);
+     Glib::Log->remove_handler ('GLib-GObject', $logid);
+
+     ok(! $sigid, 34, "'nosuchsignal' not connected");
+     require Scalar::Util;
+     Scalar::Util::weaken ($subr);
+     ok(! defined $subr, 35, "subr gc'ed after bad signal name");
+   }
 }
 
-pass(34);
+pass(36);
 
 
 
 
 __END__
 
-Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the
+Copyright (C) 2003, 2009 by the gtk2-perl team (see the file AUTHORS for the
 full list)
 
 This library is free software; you can redistribute it and/or modify it under