[perl-Glib-Object-Introspection] Avoid using vfunc names that coincide with special Perl subs

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

commit 023815a993078470ed3fa2dbbec5669aa59434d9
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Fri Jan 4 23:18:56 2013 +0100

    Avoid using vfunc names that coincide with special Perl subs
    
    Like DESTROY or END.  We already did this in one half of the vfunc handling,
    but were missing the second half.
    
    This fixes double-frees occurring for subclasses of Gtk3::Widget (which has a
    "destroy" vfunc which is now correctly mapped to "DESTROY_VFUNC" instead of
    "DESTROY").

 GObjectIntrospection.xs          |    2 +-
 NEWS                             |    6 ++++++
 gperl-i11n-info.c                |    9 +++++++++
 gperl-i11n-vfunc-interface.c     |   11 ++++++++++-
 gperl-i11n-vfunc-object.c        |   11 +++++++++++
 lib/Glib/Object/Introspection.pm |    7 +++----
 6 files changed, 40 insertions(+), 6 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index 5938e7a..306cfe4 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -159,7 +159,7 @@ static GIFieldInfo * get_field_info (GIBaseInfo *info,
                                      const gchar *field_name);
 static GType get_gtype (GIRegisteredTypeInfo *info);
 static const gchar * get_package_for_basename (const gchar *basename);
-
+static gboolean is_forbidden_sub_name (const gchar *name);
 
 /* marshallers */
 static SV * interface_to_sv (GITypeInfo* info,
diff --git a/NEWS b/NEWS
index 1c6b89f..188ba9f 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,9 @@
+Overview of changes in Glib::Object::Introspection <next>
+========================================================
+
+* Avoid using vfunc names that coincide with special Perl subs.  This fixes
+  double-frees occurring for subclasses of Gtk3::Widget.
+
 Overview of changes in Glib::Object::Introspection 0.013
 ========================================================
 
diff --git a/gperl-i11n-info.c b/gperl-i11n-info.c
index 84f102b..b61cf43 100644
--- a/gperl-i11n-info.c
+++ b/gperl-i11n-info.c
@@ -150,3 +150,12 @@ get_package_for_basename (const gchar *basename)
 	g_assert (svp && gperl_sv_is_defined (*svp));
 	return SvPV_nolen (*svp);
 }
+
+static gboolean
+is_forbidden_sub_name (const gchar *name)
+{
+	HV *forbidden_sub_names =
+		get_hv ("Glib::Object::Introspection::_FORBIDDEN_SUB_NAMES", 0);
+	g_assert (forbidden_sub_names);
+	return hv_exists (forbidden_sub_names, name, strlen (name));
+}
diff --git a/gperl-i11n-vfunc-interface.c b/gperl-i11n-vfunc-interface.c
index 4b82b90..b49f471 100644
--- a/gperl-i11n-vfunc-interface.c
+++ b/gperl-i11n-vfunc-interface.c
@@ -20,13 +20,22 @@ generic_interface_init (gpointer iface, gpointer data)
 		vfunc_info = g_interface_info_get_vfunc (info, i);
 		vfunc_name = g_base_info_get_name (vfunc_info);
 
+		perl_method_name = g_ascii_strup (vfunc_name, -1);
+		if (is_forbidden_sub_name (perl_method_name)) {
+			/* If the method name coincides with the name of one of
+			 * perl's special subs, add "_VFUNC". */
+			gchar *replacement = g_strconcat (perl_method_name, "_VFUNC", NULL);
+			g_free (perl_method_name);
+			perl_method_name = replacement;
+		}
+
 		/* FIXME: g_vfunc_info_get_offset does not seem to work here. */
 		field_info = get_field_info (struct_info, vfunc_name);
 		g_assert (field_info);
 		field_offset = g_field_info_get_offset (field_info);
 		field_type_info = g_field_info_get_type (field_info);
 
-		perl_method_name = g_ascii_strup (vfunc_name, -1);
+		/* callback_info takes over ownership of perl_method_name. */
 		callback_info = create_perl_callback_closure_for_named_sub (
 		                  field_type_info, perl_method_name);
 		dwarn ("installing vfunc %s as %s at offset %d (vs. %d) inside %p\n",
diff --git a/gperl-i11n-vfunc-object.c b/gperl-i11n-vfunc-object.c
index f7355ad..5db3a12 100644
--- a/gperl-i11n-vfunc-object.c
+++ b/gperl-i11n-vfunc-object.c
@@ -20,6 +20,14 @@ generic_class_init (GIObjectInfo *info, const gchar *target_package, gpointer cl
 		vfunc_name = g_base_info_get_name (vfunc_info);
 
 		perl_method_name = g_ascii_strup (vfunc_name, -1);
+		if (is_forbidden_sub_name (perl_method_name)) {
+			/* If the method name coincides with the name of one of
+			 * perl's special subs, add "_VFUNC". */
+			gchar *replacement = g_strconcat (perl_method_name, "_VFUNC", NULL);
+			g_free (perl_method_name);
+			perl_method_name = replacement;
+		}
+
 		{
 			/* If there is no implementation of this vfunc at INIT
 			 * time, we assume that the intention is to provide no
@@ -28,6 +36,8 @@ generic_class_init (GIObjectInfo *info, const gchar *target_package, gpointer cl
 			HV * stash = gv_stashpv (target_package, 0);
 			GV * slot = gv_fetchmethod (stash, perl_method_name);
 			if (!slot) {
+				dwarn ("skipping vfunc %s because it has no implementation\n",
+				       vfunc_name);
 				g_base_info_unref (vfunc_info);
 				g_free (perl_method_name);
 				continue;
@@ -40,6 +50,7 @@ generic_class_init (GIObjectInfo *info, const gchar *target_package, gpointer cl
 		field_offset = g_field_info_get_offset (field_info);
 		field_type_info = g_field_info_get_type (field_info);
 
+		/* callback_info takes over ownership of perl_method_name. */
 		callback_info = create_perl_callback_closure_for_named_sub (
 		                  field_type_info, perl_method_name);
 		dwarn ("installing vfunc %s as %s at offset %d (vs. %d) inside %p\n",
diff --git a/lib/Glib/Object/Introspection.pm b/lib/Glib/Object/Introspection.pm
index 933d419..2ec4550 100644
--- a/lib/Glib/Object/Introspection.pm
+++ b/lib/Glib/Object/Introspection.pm
@@ -28,10 +28,9 @@ $Carp::Internal{(__PACKAGE__)}++;
 require XSLoader;
 XSLoader::load(__PACKAGE__, $VERSION);
 
-my %FORBIDDEN_SUB_NAMES = map { $_ => 1 } qw/AUTOLOAD CLONE DESTROY BEGIN
-                                             UNITCHECK CHECK INIT END/;
 my @OBJECT_PACKAGES_WITH_VFUNCS;
-
+our %_FORBIDDEN_SUB_NAMES = map { $_ => 1 } qw/AUTOLOAD CLONE DESTROY BEGIN
+                                               UNITCHECK CHECK INIT END/;
 our %_BASENAME_TO_PACKAGE;
 our %_REBLESSERS;
 
@@ -178,7 +177,7 @@ sub setup {
         VFUNC:
         foreach my $vfunc_names (@vfuncs) {
           my ($vfunc_name, $perl_vfunc_name) = @{$vfunc_names};
-          if (exists $FORBIDDEN_SUB_NAMES{$perl_vfunc_name}) {
+          if (exists $_FORBIDDEN_SUB_NAMES{$perl_vfunc_name}) {
             $perl_vfunc_name .= '_VFUNC';
           }
           my $full_perl_vfunc_name =