1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
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
|
