perl-Glib r1104 - in trunk: . t

[tsch svn gnome org]

Author: tsch
Date: Sun Mar  1 17:26:01 2009
New Revision: 1104
URL: http://svn.gnome.org/viewvc/perl-Glib?rev=1104&view=rev

Log:
(gperl_signal_connect): Don't leak the GClosure object when an invalid signal
name is passed in.  Patch by Kevin Ryde.


Modified:
   trunk/ChangeLog
   trunk/GSignal.xs
   trunk/t/7.t

Modified: trunk/GSignal.xs
==============================================================================
--- trunk/GSignal.xs	(original)
+++ trunk/GSignal.xs	Sun Mar  1 17:26:01 2009
@@ -1,6 +1,6 @@
 /*
- * Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for
- * the full list)
+ * 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
  * under the terms of the GNU Library General Public License as published by
@@ -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;
 }
 
 /*

Modified: trunk/t/7.t
==============================================================================
--- trunk/t/7.t	(original)
+++ trunk/t/7.t	Sun Mar  1 17:26:01 2009
@@ -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