Mon May 27 00:29:16 PDT 2013

2 files changed, 243 insertions, 4 deletions

diff --git a/extra/glib-perl/0001-Make-Glib-Object-subclassing-more-robust.patch b/extra/glib-perl/0001-Make-Glib-Object-subclassing-more-robust.patch
new file mode 100644
index 000000000..fe92fbd94
--- /dev/null
+++ b/extra/glib-perl/0001-Make-Glib-Object-subclassing-more-robust.patch
@@ -0,0 +1,230 @@
+From ebf55199407d3be92162f5c2573c7f9c34614cb1 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Torsten=20Sch=C3=B6nfeld?= <kaffeetisch@gmx.de>
+Date: Thu, 2 Aug 2012 21:41:41 +0200
+Subject: [PATCH] Make Glib::Object subclassing more robust
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Rearrange how we register the interfaces, properties and signals of a newly
+created type so that:
+
+• The outcome is independent of the order of the arguments passed to
+Glib::Object::Subclass or Glib::Type->register.  This also avoids fallout from
+the change to hash randomization in perl 5.17.6.
+
+• We register things in the correct order: interfaces first, before entering
+class_init; then properties and signals from within class_init.  This also
+avoids prematurely creating the new type's class.
+---
+ GType.xs | 92 ++++++++++++++++++++++++++++++++++++++++++++++++----------------
+ NEWS     |  7 +++++
+ 2 files changed, 77 insertions(+), 22 deletions(-)
+
+diff --git a/GType.xs b/GType.xs
+index 02e24a4..fdaad68 100644
+--- a/GType.xs
++++ b/GType.xs
+@@ -1234,13 +1234,10 @@ parse_signal_hash (GType instance_type,
+ 
+ 
+ static void
+-add_signals (GType instance_type, HV * signals)
++add_signals (GType instance_type, HV * signals, AV * interfaces)
+ {
+-	GObjectClass *oclass;
+ 	HE * he;
+ 
+-	oclass = g_type_class_ref (instance_type);
+-
+ 	hv_iterinit (signals);
+ 	while (NULL != (he = hv_iternext (signals))) {
+ 		I32 keylen;
+@@ -1250,9 +1247,36 @@ add_signals (GType instance_type, HV * signals)
+ 
+ 		/* the key is the signal name */
+ 		signal_name = hv_iterkey (he, &keylen);
+-		/* if the signal is defined at this point, we're going to
+-		 * override the installed closure. */
+-		signal_id = g_signal_lookup (signal_name, instance_type);
++
++		/* if, at this point, the signal is already defined in the
++		 * ancestry or the interfaces we just added to instance_type,
++		 * we can only override the installed closure.  trying to
++		 * create a new signal with the same name is an error.
++		 *
++		 * unfortunately, we cannot simply use instance_type to do the
++		 * lookup because g_signal_lookup would complain about it since
++		 * it hasn't been fully loaded yet.  see
++		 * <https://bugzilla.gnome.org/show_bug.cgi?id=691096>.
++		 *
++		 * FIXME: the "if (signal_id)" check in the hash ref block
++		 * below could be removed since g_signal_newv also checks this.
++		 * consequently, this lookup code could be moved into the class
++		 * closure block below. */
++		signal_id = g_signal_lookup (signal_name,
++		                             g_type_parent (instance_type));
++		if (!signal_id && interfaces) {
++			int i;
++			for (i = 0; i <= av_len (interfaces); i++) {
++				GType interface_type;
++				SV ** svp = av_fetch (interfaces, i, FALSE);
++				if (!svp || !gperl_sv_is_defined (*svp))
++					continue;
++				interface_type = gperl_object_type_from_package (SvPV_nolen (*svp));
++				signal_id = g_signal_lookup (signal_name, interface_type);
++				if (signal_id)
++					break;
++			}
++		}
+ 
+ 		/* parse the key's value... */
+ 		value = hv_iterval (signals, he);
+@@ -1310,8 +1334,6 @@ add_signals (GType instance_type, HV * signals)
+ 			       signal_name);
+ 		}
+ 	}
+-
+-	g_type_class_unref (oclass);
+ }
+ 
+ typedef struct {
+@@ -1407,13 +1429,10 @@ prop_handler_lookup (GType instance_type,
+ }
+ 
+ static void
+-add_properties (GType instance_type, AV * properties)
++add_properties (GType instance_type, GObjectClass * oclass, AV * properties)
+ {
+-	GObjectClass *oclass;
+ 	int propid;
+ 
+-	oclass = g_type_class_ref (instance_type);
+-
+ 	for (propid = 0; propid <= av_len (properties); propid++) {
+ 		SV * sv = *av_fetch (properties, propid, 1);
+ 		GParamSpec * pspec = NULL;
+@@ -1452,8 +1471,6 @@ add_properties (GType instance_type, AV * properties)
+ 		}
+ 		g_object_class_install_property (oclass, propid + 1, pspec);
+ 	}
+-
+-	g_type_class_unref (oclass);
+ }
+ 
+ /*
+@@ -1776,12 +1793,26 @@ gperl_type_reg_quark (void)
+ 	return q;
+ }
+ 
++typedef struct {
++	GType instance_type;
++	AV *interfaces;
++	AV *properties;
++	HV *signals;
++} GPerlClassData;
++
+ static void
+-gperl_type_class_init (GObjectClass * class)
++gperl_type_class_init (GObjectClass * class, GPerlClassData * class_data)
+ {
+ 	class->finalize     = gperl_type_finalize;
+ 	class->get_property = gperl_type_get_property;
+ 	class->set_property = gperl_type_set_property;
++
++	if (class_data->properties)
++		add_properties (class_data->instance_type, class,
++		                class_data->properties);
++	if (class_data->signals)
++		add_signals (class_data->instance_type,
++		             class_data->signals, class_data->interfaces);
+ }
+ 
+ static void
+@@ -2152,15 +2183,18 @@ g_type_register_object (class, parent_package, new_package, ...);
+     PREINIT:
+ 	int i;
+ 	GTypeInfo type_info;
++	GPerlClassData class_data;
+ 	GTypeQuery query;
+ 	GType parent_type, new_type;
+ 	char * new_type_name;
+     CODE:
+ 	/* start with a clean slate */
+ 	memset (&type_info, 0, sizeof (GTypeInfo));
++	memset (&class_data, 0, sizeof (GPerlClassData));
+ 	type_info.base_init = (GBaseInitFunc) gperl_type_base_init;
+ 	type_info.class_init = (GClassInitFunc) gperl_type_class_init;
+ 	type_info.instance_init = (GInstanceInitFunc) gperl_type_instance_init;
++	type_info.class_data = &class_data;
+ 
+ 	/* yeah, i could just call gperl_object_type_from_package directly,
+ 	 * but i want the error messages to be more informative. */
+@@ -2196,29 +2230,43 @@ g_type_register_object (class, parent_package, new_package, ...);
+ 	/* mark this type as "one of ours". */
+ 	g_type_set_qdata (new_type, gperl_type_reg_quark (), (gpointer) TRUE);
+ 
+-	/* now look for things we should initialize presently, e.g.
+-	 * signals and properties and interfaces and such, things that
+-	 * would generally go into a class_init. */
++	/* put it into the class data so that add_signals and add_properties
++	 * can use it. */
++	class_data.instance_type = new_type;
++
++	/* now look for things we should initialize, e.g. signals and
++	 * properties and interfaces.  put the corresponding data into the
++	 * class_data struct.  the interfaces will be handled directly further
++	 * below, while the properties and signals will be handled in the
++	 * class_init function so that they have access to the class instance.
++	 * this mimics the way things are supposed to be done in C: register
++	 * interfaces in the get_type function, and register properties and
++	 * signals in the class_init function. */
+ 	for (i = 3 ; i < items ; i += 2) {
+ 		char * key = SvPV_nolen (ST (i));
+ 		if (strEQ (key, "signals")) {
+ 			if (gperl_sv_is_hash_ref (ST (i+1)))
+-				add_signals (new_type, (HV*)SvRV (ST (i+1)));
++				class_data.signals = (HV*)SvRV (ST (i+1));
+ 			else
+ 				croak ("signals must be a hash of signalname => signalspec pairs");
+ 		} else if (strEQ (key, "properties")) {
+ 			if (gperl_sv_is_array_ref (ST (i+1)))
+-				add_properties (new_type, (AV*)SvRV (ST (i+1)));
++				class_data.properties = (AV*)SvRV (ST (i+1));
+ 			else
+ 				croak ("properties must be an array of GParamSpecs");
+ 		} else if (strEQ (key, "interfaces")) {
+ 			if (gperl_sv_is_array_ref (ST (i+1)))
+-				add_interfaces (new_type, (AV*)SvRV (ST (i+1)));
++				class_data.interfaces = (AV*)SvRV (ST (i+1));
+ 			else
+ 				croak ("interfaces must be an array of package names");
+ 		}
+ 	}
+ 
++	/* add the interfaces to the type now before we create its class and
++	 * enter the class_init function. */
++	if (class_data.interfaces)
++		add_interfaces (new_type, class_data.interfaces);
++
+ 	/* instantiate the class right now.  perl doesn't let classes go
+ 	 * away once they've been defined, so we'll just leak this ref and
+ 	 * let the GObjectClass live as long as the program.  in fact,
+diff --git a/NEWS b/NEWS
+index 5606566..ad71da0 100644
+--- a/NEWS
++++ b/NEWS
+@@ -1,3 +1,10 @@
++Overview of changes in Glib <next> (unstable)
++============================================
++
++* Make Glib::Object subclassing more robust.  This should in particular fix
++  issues revealed by the change to hash randomization introduced in perl
++  5.17.6.
++
+ Overview of changes in Glib 1.280 (stable)
+ ==========================================
+ 
+-- 
+1.8.2.3
+
diff --git a/extra/glib-perl/PKGBUILD b/extra/glib-perl/PKGBUILD
index 352cff1c5..f4a870312 100644
--- a/extra/glib-perl/PKGBUILD
+++ b/extra/glib-perl/PKGBUILD
@@ -1,10 +1,10 @@
-# $Id: PKGBUILD 183484 2013-04-21 22:21:04Z heftig $
+# $Id: PKGBUILD 186376 2013-05-26 09:24:27Z bluewind $
 # Maintainer: Jan de Groot <jgc@archlinux.org>
 # Contributor: Sarah Hay <sarah@archlinux.org>
 
 pkgname=glib-perl
 pkgver=1.280
-pkgrel=1
+pkgrel=3
 pkgdesc="Perl wrappers for glib 2.x, including GObject"
 arch=(i686 x86_64)
 license=('LGPL')
@@ -12,8 +12,17 @@ url="http://gtk2-perl.sourceforge.net/"
 options=('!emptydirs')
 depends=('glib2' 'perl')
 makedepends=('perl-extutils-depends' 'perl-extutils-pkgconfig')
-source=(http://downloads.sourceforge.net/sourceforge/gtk2-perl/Glib-${pkgver}.tar.gz)
-md5sums=('1d81a8aec5f7f1182a96cfaaf119d866')
+source=(http://downloads.sourceforge.net/sourceforge/gtk2-perl/Glib-${pkgver}.tar.gz
+        0001-Make-Glib-Object-subclassing-more-robust.patch)
+md5sums=('1d81a8aec5f7f1182a96cfaaf119d866'
+         'ebe39d50eff182a1ad4390cbbef46e41')
+
+prepare() {
+  cd "${srcdir}/Glib-${pkgver}"
+
+  # Needed for gtk2-perl to compile against Perl 5.18
+  patch -Np1 -i "${srcdir}/0001-Make-Glib-Object-subclassing-more-robust.patch"
+}
 
 build() {
   cd "${srcdir}/Glib-${pkgver}"