On 24.09.2013 01:13, Terence Ferraro wrote:
> use Gtk3 -init;
> require String::Approx; String::Approx->import qw(amatch);
> my $foo = String::Approx::amatch("foobar", ["3 i"], "foobor");
> my $store = Gtk3::ListStore->new(qw/Glib::String/);
> $store->insert_with_values(0,0,'0');
> $store->insert_with_values(1,0,'1');
>
> Produces this:
> "Could at testgtk.pl <http://testgtk.pl> line 5."
I've seen this behavior before with XML::Parser. I "fixed" it back then
as described here: <https://github.com/chorny/XML-Parser/pull/4>. But
later I realized that it is actually a problem in nearly all of
gtk-perl. We use the C macro PL_na incorrectly, and whenever a
third-party XS module uses PL_na in a specific way, we break.
Unfortunately, I forgot about this until you brought it up. It's now
fixed with two commits to Glib and G:O:I. But we should really go
through all of gtk-perl and make similar changes.
(GNOME's SSH access to Git seems to be broken right now, so I'm
attaching the patches.)
Can you verify that this fixes your problem, too?
>From c62c3e47cea5c3945fde58e858c78ae1334192cc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Torsten=20Sch=C3=B6nfeld?= <kaffeeti...@gmx.de>
Date: Tue, 24 Sep 2013 19:56:05 +0200
Subject: [PATCH] Avoid misusing PL_na
We used to do "newSVpv (string, PL_na)" when we didn't know the string's
length. That's not correct, and breaks if other XS modules write to PL_na,
which is what PL_na is intended for. Simply use "newSVpv (string, 0)" instead.
---
GOption.xs | 2 +-
GType.xs | 2 +-
Glib.xs | 2 +-
NEWS | 8 ++++++++
4 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/GOption.xs b/GOption.xs
index c20cbb4..0c7defe 100644
--- a/GOption.xs
+++ b/GOption.xs
@@ -547,7 +547,7 @@ sv_from_filenames (gchar **filenames)
av = newAV ();
for (i = 0; filenames[i] != NULL; i++) {
/* FIXME: Is this the correct converter? */
- av_push (av, newSVpv (filenames[i], PL_na));
+ av_push (av, newSVpv (filenames[i], 0));
}
return newRV_noinc ((SV *) av);
diff --git a/GType.xs b/GType.xs
index d59ee18..6f9c1dd 100644
--- a/GType.xs
+++ b/GType.xs
@@ -1505,7 +1505,7 @@ install_overrides (GType type)
PUSHMARK (SP);
if (!name)
name = gperl_object_package_from_type (type);
- XPUSHs (sv_2mortal (newSVpv (name, PL_na)));
+ XPUSHs (sv_2mortal (newSVpv (name, 0)));
PUTBACK;
call_sv ((SV *)GvCV (*slot), G_VOID|G_DISCARD);
FREETMPS;
diff --git a/Glib.xs b/Glib.xs
index dac2c47..a709050 100644
--- a/Glib.xs
+++ b/Glib.xs
@@ -285,7 +285,7 @@ gperl_argv_update (GPerlArgv *pargv)
SV *sv;
const char *arg = pargv->argv[i];
gboolean utf8_flag = !!g_hash_table_lookup (priv->utf8_flags, arg);
- sv = newSVpv (arg, PL_na);
+ sv = newSVpv (arg, 0);
if (utf8_flag)
SvUTF8_on (sv);
av_push (ARGV, sv);
diff --git a/NEWS b/NEWS
index 28a0855..379d957 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,11 @@
+Overview of changes in Glib <next>
+==========================================
+
+* Avoid misusing the macro PL_na, thus preventing issues when Glib is used in
+ conjunction with certain XS modules, among them XML::Parser and
+ String::Approx.
+* Avoid memory corruption when registering boxed synonyms repeatedly.
+
Overview of changes in Glib 1.301 (stable)
==========================================
--
1.8.1.2
>From b9bbcdb4fe66bb2da158b62567301875c52f0e2d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Torsten=20Sch=C3=B6nfeld?= <kaffeeti...@gmx.de>
Date: Tue, 24 Sep 2013 19:58:50 +0200
Subject: [PATCH] Avoid misusing PL_na
We used to do "newSVpv (string, PL_na)" when we didn't know the string's
length. That's not correct, and breaks if other XS modules write to PL_na,
which is what PL_na is intended for. Simply use "newSVpv (string, 0)" instead.
---
GObjectIntrospection.xs | 10 +++++-----
NEWS | 8 ++++++++
gperl-i11n-croak.c | 4 ++--
gperl-i11n-field.c | 4 ++--
gperl-i11n-marshal-arg.c | 4 ++--
gperl-i11n-method.c | 2 +-
gperl-i11n-vfunc-object.c | 2 +-
7 files changed, 21 insertions(+), 13 deletions(-)
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index 26341ee..69f60f1 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -358,15 +358,15 @@ _register_types (class, namespace, package)
dwarn ("setting up %s.%s\n", namespace, name);
if (info_type == GI_INFO_TYPE_CONSTANT) {
- av_push (constants, newSVpv (name, PL_na));
+ av_push (constants, newSVpv (name, 0));
}
if (info_type == GI_INFO_TYPE_FUNCTION) {
- av_push (global_functions, newSVpv (name, PL_na));
+ av_push (global_functions, newSVpv (name, 0));
}
if (info_type == GI_INFO_TYPE_INTERFACE) {
- av_push (interfaces, newSVpv (name, PL_na));
+ av_push (interfaces, newSVpv (name, 0));
}
if (info_type == GI_INFO_TYPE_OBJECT ||
@@ -747,7 +747,7 @@ _find_non_perl_parents (class, basename, object_name, target_package)
while ((gtype = g_type_parent (gtype))) {
if (!g_type_get_qdata (gtype, reg_quark)) {
const gchar *package = gperl_object_package_from_type (gtype);
- XPUSHs (sv_2mortal (newSVpv (package, PL_na)));
+ XPUSHs (sv_2mortal (newSVpv (package, 0)));
}
if (gtype == object_gtype) {
break;
@@ -785,7 +785,7 @@ _find_vfuncs_with_implementation (class, object_package, target_package)
/* FIXME: g_vfunc_info_get_offset does not seem to work here. */
field_offset = get_vfunc_offset (object_info, vfunc_name);
if (G_STRUCT_MEMBER (gpointer, target_klass, field_offset)) {
- XPUSHs (sv_2mortal (newSVpv (vfunc_name, PL_na)));
+ XPUSHs (sv_2mortal (newSVpv (vfunc_name, 0)));
}
g_base_info_unref (vfunc_info);
}
diff --git a/NEWS b/NEWS
index 40dd082..1aca2e4 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,11 @@
+Overview of changes in Glib::Object::Introspection <next>
+========================================================
+
+* Avoid misusing the macro PL_na, thus preventing issues when
+ Glib::Object::Introspection is used in conjunction with certain XS modules,
+ among them XML::Parser and String::Approx.
+* Fix build on MinGW with dmake.
+
Overview of changes in Glib::Object::Introspection 0.015
========================================================
diff --git a/gperl-i11n-croak.c b/gperl-i11n-croak.c
index 33b0ed8..6c41cac 100644
--- a/gperl-i11n-croak.c
+++ b/gperl-i11n-croak.c
@@ -12,7 +12,7 @@ call_carp_croak (const char *msg)
SAVETMPS;
PUSHMARK (SP);
- XPUSHs (sv_2mortal (newSVpv(msg, PL_na)));
+ XPUSHs (sv_2mortal (newSVpv(msg, 0)));
PUTBACK;
call_pv("Carp::croak", G_VOID | G_DISCARD);
@@ -31,7 +31,7 @@ call_carp_carp (const char *msg)
SAVETMPS;
PUSHMARK (SP);
- XPUSHs (sv_2mortal (newSVpv(msg, PL_na)));
+ XPUSHs (sv_2mortal (newSVpv(msg, 0)));
PUTBACK;
call_pv("Carp::carp", G_VOID | G_DISCARD);
diff --git a/gperl-i11n-field.c b/gperl-i11n-field.c
index 6c7c116..0d27537 100644
--- a/gperl-i11n-field.c
+++ b/gperl-i11n-field.c
@@ -21,7 +21,7 @@ store_fields (HV *fields, GIBaseInfo *info, GIInfoType info_type)
const gchar *field_name;
field_info = g_struct_info_get_field ((GIStructInfo *) info, i);
field_name = g_base_info_get_name ((GIBaseInfo *) field_info);
- av_push (av, newSVpv (field_name, PL_na));
+ av_push (av, newSVpv (field_name, 0));
g_base_info_unref ((GIBaseInfo *) field_info);
}
break;
@@ -35,7 +35,7 @@ store_fields (HV *fields, GIBaseInfo *info, GIInfoType info_type)
const gchar *field_name;
field_info = g_union_info_get_field ((GIUnionInfo *) info, i);
field_name = g_base_info_get_name ((GIBaseInfo *) field_info);
- av_push (av, newSVpv (field_name, PL_na));
+ av_push (av, newSVpv (field_name, 0));
g_base_info_unref ((GIBaseInfo *) field_info);
}
break;
diff --git a/gperl-i11n-marshal-arg.c b/gperl-i11n-marshal-arg.c
index 539b7e3..74cfa49 100644
--- a/gperl-i11n-marshal-arg.c
+++ b/gperl-i11n-marshal-arg.c
@@ -228,7 +228,7 @@ arg_to_sv (GIArgument * arg,
package = gperl_package_from_type (gtype);
if (!package)
package = g_type_name (gtype);
- return package ? newSVpv (package, PL_na) : &PL_sv_undef;
+ return package ? newSVpv (package, 0) : &PL_sv_undef;
}
case GI_TYPE_TAG_ARRAY:
@@ -258,7 +258,7 @@ arg_to_sv (GIArgument * arg,
case GI_TYPE_TAG_FILENAME:
{
- SV *sv = newSVpv (arg->v_string, PL_na);
+ SV *sv = newSVpv (arg->v_string, 0);
if (own)
g_free (arg->v_string);
return sv;
diff --git a/gperl-i11n-method.c b/gperl-i11n-method.c
index 1759721..9439e73 100644
--- a/gperl-i11n-method.c
+++ b/gperl-i11n-method.c
@@ -7,7 +7,7 @@
const gchar *function_name; \
function_info = g_ ## prefix ## _info_get_method (info, i); \
function_name = g_base_info_get_name (function_info); \
- av_push (av, newSVpv (function_name, PL_na)); \
+ av_push (av, newSVpv (function_name, 0)); \
g_base_info_unref (function_info); \
}
diff --git a/gperl-i11n-vfunc-object.c b/gperl-i11n-vfunc-object.c
index b2b5282..6e3f48f 100644
--- a/gperl-i11n-vfunc-object.c
+++ b/gperl-i11n-vfunc-object.c
@@ -6,7 +6,7 @@ store_objects_with_vfuncs (AV *objects_with_vfuncs, GIObjectInfo *info)
if (g_object_info_get_n_vfuncs (info) <= 0)
return;
av_push (objects_with_vfuncs,
- newSVpv (g_base_info_get_name (info), PL_na));
+ newSVpv (g_base_info_get_name (info), 0));
}
/* ------------------------------------------------------------------------- */
--
1.8.1.2
_______________________________________________
gtk-perl-list mailing list
gtk-perl-list@gnome.org
https://mail.gnome.org/mailman/listinfo/gtk-perl-list
