[perl-Gtk2] Simplify the callback handling in two interfaces

[Torsten SchÃnfeld <tsch src gnome org>]

commit a06ce799444e9643494cea3ea5e8abe140b01d90
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Mon Oct 3 17:11:54 2011 +0200

    Simplify the callback handling in two interfaces
    
    Namely Gtk2::CellLayout and Gtk2::TreeSortable.  Instead of mucking
    around with dummy CVs, we now simply create a wrapper SV that is in turn
    put into a reference SV with &{} overloading.  This is much simpler and
    doesn't leak.
    
    https://bugzilla.gnome.org/show_bug.cgi?id=636819
    https://bugzilla.gnome.org/show_bug.cgi?id=636822

 Gtk2.pm               |   10 ++++++-
 t/GtkTreeModelIface.t |    4 +-
 xs/GtkCellLayout.xs   |   38 ++++++++++----------------------
 xs/GtkTreeSortable.xs |   58 +++++++++++++++++-------------------------------
 4 files changed, 43 insertions(+), 67 deletions(-)
---
diff --git a/Gtk2.pm b/Gtk2.pm
index 2beb847..5622aba 100644
--- a/Gtk2.pm
+++ b/Gtk2.pm
@@ -163,13 +163,19 @@ use overload
 package Gtk2::CellLayout::DataFunc;
 
 use overload
-	'&{}' => sub { \&Gtk2::CellLayout::DataFunc::invoke },
+	'&{}' => sub {
+                   my ($func) = @_;
+                   return sub { Gtk2::CellLayout::DataFunc::invoke($func, @_) }
+                 },
 	fallback => 1;
 
 package Gtk2::TreeSortable::IterCompareFunc;
 
 use overload
-	'&{}' => sub { \&Gtk2::TreeSortable::IterCompareFunc::invoke },
+	'&{}' => sub {
+                   my ($func) = @_;
+                   return sub { Gtk2::TreeSortable::IterCompareFunc::invoke($func, @_) };
+                 },
 	fallback => 1;
 
 package Gtk2::TreeModelSort;
diff --git a/t/GtkTreeModelIface.t b/t/GtkTreeModelIface.t
index c90d2f2..3b8e83d 100644
--- a/t/GtkTreeModelIface.t
+++ b/t/GtkTreeModelIface.t
@@ -300,7 +300,7 @@ sub SET_SORT_FUNC {
 
 	isa_ok ($list, "CustomList");
 	ok ($id == 2 || $id == 3);
-	isa_ok ($func, "CODE");
+	isa_ok ($func, "Gtk2::TreeSortable::IterCompareFunc");
 	ok (defined $data);
 
 	$list->{sort_funcs}->[$id] = [$func, $data];
@@ -310,7 +310,7 @@ sub SET_DEFAULT_SORT_FUNC {
 	my ($list, $func, $data) = @_;
 
 	isa_ok ($list, "CustomList");
-	isa_ok ($func, "CODE");
+	isa_ok ($func, "Gtk2::TreeSortable::IterCompareFunc");
 	ok (defined $data);
 
 	$list->{sort_func_default} = [$func, $data];
diff --git a/xs/GtkCellLayout.xs b/xs/GtkCellLayout.xs
index 12883f6..ee1e94a 100644
--- a/xs/GtkCellLayout.xs
+++ b/xs/GtkCellLayout.xs
@@ -141,26 +141,17 @@ create_callback (GtkCellLayoutDataFunc func,
                  SV                  **data_return)
 {
 	HV *stash;
-	gchar *sub;
-	CV *dummy_cv = NULL;
 	SV *code_sv, *data_sv;
 	Gtk2PerlCellLayoutDataFunc *wrapper;
 
-	stash = gv_stashpv ("Gtk2::CellLayout::DataFunc", TRUE);
-
-	sub = g_strdup_printf ("__gtk2perl_cell_layout_data_func_%p", data);
-	dummy_cv = newCONSTSUB (stash, sub, NULL);
-	g_free (sub);
-
-	code_sv = sv_bless (newRV_noinc ((SV *) dummy_cv), stash);
-
 	wrapper = g_new0 (Gtk2PerlCellLayoutDataFunc, 1);
 	wrapper->func = func;
 	wrapper->data = data;
 	wrapper->destroy = destroy;
-
 	data_sv = newSViv (PTR2IV (wrapper));
-	_gperl_attach_mg ((SV *) dummy_cv, data_sv);
+
+	stash = gv_stashpv ("Gtk2::CellLayout::DataFunc", TRUE);
+	code_sv = sv_bless (newRV (data_sv), stash);
 
 	*code_return = code_sv;
 	*data_return = data_sv;
@@ -185,8 +176,8 @@ gtk2perl_cell_layout_set_cell_data_func (GtkCellLayout         *cell_layout,
 			create_callback (func, func_data, destroy,
 					 &code_sv, &data_sv);
 
-			XPUSHs (sv_2mortal (newSVsv (code_sv)));
-			XPUSHs (sv_2mortal (newSVsv (data_sv)));
+			XPUSHs (sv_2mortal (code_sv));
+			XPUSHs (sv_2mortal (data_sv));
 		}
 
 		CALL;
@@ -493,32 +484,27 @@ gtk_cell_layout_get_cells (GtkCellLayout *cell_layout)
 
 MODULE = Gtk2::CellLayout	PACKAGE = Gtk2::CellLayout::DataFunc
 
+=for apidoc __hide__
+=cut
 void
-invoke (GtkCellLayout *cell_layout, GtkCellRenderer *cell, GtkTreeModel *tree_model, GtkTreeIter *iter, SV *data)
+invoke (SV *code, GtkCellLayout *cell_layout, GtkCellRenderer *cell, GtkTreeModel *tree_model, GtkTreeIter *iter, data)
     PREINIT:
 	Gtk2PerlCellLayoutDataFunc *wrapper;
     CODE:
-	wrapper = INT2PTR (Gtk2PerlCellLayoutDataFunc*, SvIV (data));
+	wrapper = INT2PTR (Gtk2PerlCellLayoutDataFunc*, SvIV (SvRV (code)));
 	if (!wrapper || !wrapper->func)
-		croak ("Invalid user data passed to the data func");
+		croak ("Invalid reference encountered in cell data func");
 	wrapper->func (cell_layout, cell, tree_model, iter, wrapper->data);
 
 void
 DESTROY (SV *code)
     PREINIT:
-	MAGIC *mg;
 	Gtk2PerlCellLayoutDataFunc *wrapper;
     CODE:
-	if (!gperl_sv_is_defined (code) || !SvROK (code)
-	    || !(mg = _gperl_find_mg (SvRV (code))))
+	if (!gperl_sv_is_defined (code) || !SvROK (code))
 		return;
-
-	wrapper = INT2PTR (Gtk2PerlCellLayoutDataFunc*, SvIV ((SV *) mg->mg_ptr));
-	SvREFCNT_dec ((SV *) mg->mg_ptr);
-
+	wrapper = INT2PTR (Gtk2PerlCellLayoutDataFunc*, SvIV (SvRV (code)));
 	if (wrapper && wrapper->destroy)
 		wrapper->destroy (wrapper->data);
-
-	_gperl_remove_mg (SvRV (code));
 	if (wrapper)
 		g_free (wrapper);
diff --git a/xs/GtkTreeSortable.xs b/xs/GtkTreeSortable.xs
index 92e2b57..3e7be6b 100644
--- a/xs/GtkTreeSortable.xs
+++ b/xs/GtkTreeSortable.xs
@@ -103,13 +103,11 @@ gtk2perl_tree_sortable_set_sort_column_id (GtkTreeSortable *sortable,
 
 /* ------------------------------------------------------------------------- */
 
-/* The strategy: Create a dummy CV and bless it into some namespace.  Put the
- * given function pointer, user data and destruction notification pointer into
- * a struct.  Pass that struct as user data to the actual Perl sub routine.
- * When the Perl programmer then invokes the code reference, we recreate every
- * necessary bit in the invoke handler and call the C function.  Also attach
- * the struct as magic to the dummy so we can get at the destroy pointer in
- * DESTROY. */
+/* The strategy: Put the given function pointer, user data and destruction
+ * notification pointer into a struct.  Make an IV SV pointing to that struct.
+ * Create a blessed reference around this SV which has &{} overloading.  When
+ * the Perl programmer then invokes this SV, we recreate every necessary bit in
+ * the invoke handler and call the C function. */
 
 typedef struct {
 	GtkTreeIterCompareFunc func;
@@ -125,29 +123,20 @@ create_callback (GtkTreeIterCompareFunc func,
                  SV                   **data_return)
 {
 	HV *stash;
-	gchar *sub;
-	CV *dummy = NULL;
-	SV *code, *my_data;
+	SV *code_sv, *data_sv;
 	Gtk2PerlTreeIterCompareFunc *stuff;
 
-	stash = gv_stashpv ("Gtk2::TreeSortable::IterCompareFunc", TRUE);
-
-	sub = g_strdup_printf ("__gtk2perl_tree_iter_compare_func_%p", data);
-	dummy = newCONSTSUB (stash, sub, NULL);
-	g_free (sub);
-
-	code = sv_bless (newRV_noinc ((SV *) dummy), stash);
-
 	stuff = g_new0 (Gtk2PerlTreeIterCompareFunc, 1);
 	stuff->func = func;
 	stuff->data = data;
 	stuff->destroy = destroy;
+	data_sv = newSViv (PTR2IV (stuff));
 
-	my_data = newSViv (PTR2IV (stuff));
-	_gperl_attach_mg ((SV *) dummy, my_data);
+	stash = gv_stashpv ("Gtk2::TreeSortable::IterCompareFunc", TRUE);
+	code_sv = sv_bless (newRV (data_sv), stash);
 
-	*code_return = code;
-	*data_return = my_data;
+	*code_return = code_sv;
+	*data_return = data_sv;
 }
 
 static void
@@ -166,8 +155,8 @@ gtk2perl_tree_sortable_set_sort_func (GtkTreeSortable       *sortable,
 		create_callback (func, data, destroy, &code, &my_data);
 
 		XPUSHs (sv_2mortal (newSViv (sort_column_id)));
-		XPUSHs (sv_2mortal (newSVsv (code)));
-		XPUSHs (sv_2mortal (newSVsv (my_data)));
+		XPUSHs (sv_2mortal (code));
+		XPUSHs (sv_2mortal (my_data));
 
 		CALL;
 
@@ -426,18 +415,20 @@ gtk_tree_sortable_has_default_sort_func (sortable)
 
 MODULE = Gtk2::TreeSortable	PACKAGE = Gtk2::TreeSortable::IterCompareFunc
 
+=for apidoc __hide__
+=cut
 gint
-invoke (model, a, b, data)
+invoke (code, model, a, b, data)
+	SV *code
 	GtkTreeModel *model
 	GtkTreeIter *a
 	GtkTreeIter *b
-	SV *data
     PREINIT:
 	Gtk2PerlTreeIterCompareFunc *stuff;
     CODE:
-	stuff = INT2PTR (Gtk2PerlTreeIterCompareFunc*, SvIV (data));
+	stuff = INT2PTR (Gtk2PerlTreeIterCompareFunc*, SvIV (SvRV (code)));
 	if (!stuff || !stuff->func)
-		croak ("Invalid data passed to the iter compare func");
+		croak ("Invalid reference encountered in iter compare func");
 	RETVAL = stuff->func (model, a, b, stuff->data);
     OUTPUT:
 	RETVAL
@@ -446,19 +437,12 @@ void
 DESTROY (code)
 	SV *code
     PREINIT:
-	MAGIC *mg;
 	Gtk2PerlTreeIterCompareFunc *stuff;
     CODE:
-	if (!gperl_sv_is_defined (code) || !SvROK (code)
-	    || !(mg = _gperl_find_mg (SvRV (code))))
+	if (!gperl_sv_is_defined (code) || !SvROK (code))
 		return;
-
-	stuff = INT2PTR (Gtk2PerlTreeIterCompareFunc*, SvIV ((SV *) mg->mg_ptr));
-	SvREFCNT_dec ((SV *) mg->mg_ptr);
-
+	stuff = INT2PTR (Gtk2PerlTreeIterCompareFunc*, SvIV (SvRV (code)));
 	if (stuff && stuff->destroy)
 		stuff->destroy (stuff->data);
-
-	_gperl_remove_mg (SvRV (code));
 	if (stuff)
 		g_free (stuff);