Re: segv on stack extending

[Torsten Schoenfeld <kaffeetisch gmx de>]

Kevin Ryde wrote:
> The two programs below get segvs for me.

Ouch, good catch.

> I suspect it's a stack pointer PUTBACK problem in the $obj->get xsub.
> The contortions of grow_the_stack() provoke an EXTEND(SP,n) deep inside
> g_object_get() proper, but coming back to the $obj->get xsub the
> "PPCODE" ends with a PUTBACK of an old and now invalidated SP pointer.
>
> [...]
>
> Does that sound likely?  If so I guess it's only the usual
> PUTBACK/SPAGAIN rules of a call_sv(), except buried down through multi
> layers of funcs into and then back out of gtk.

Yeah, I think this is what's happening.  Unfortunately, Glib::Object::get also
uses ST in the loop to access the global stack pointer directly.  Your patch
breaks this.  Example: $obj->get ('foo', 'foo') in your region.pl.  Glib/t/f.t
triggers this as well.

The only solution I can think of is to fetch the name arguments in a separate
loop, as in the attached patch.  This is ugly and, since it involves heap
allocation, certainly slower than the original implementation.  But we seem to
value correctness higher than speed. :-)  But maybe there's a better way?

-- 

Index: GObject.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/GObject.xs,v
retrieving revision 1.76
diff -u -d -p -r1.76 GObject.xs
--- GObject.xs  3 Aug 2008 16:01:12 -0000       1.76
+++ GObject.xs  31 Aug 2008 18:11:11 -0000
@@ -1190,17 +1190,31 @@ g_object_get (object, ...)
     PREINIT:
        GValue value = {0,};
        int i;
+       char **names;
     PPCODE:
        PERL_UNUSED_VAR (ix);
-       EXTEND (SP, items-1);
+
+       /* Fetch the names from the stack in a separate loop because we have to
+        * synchronize the local and the global stack pointer in the loop
+        * below.  And this can potentially overwrite the names arguments. */
+       names = g_new (char *, items-1);
        for (i = 1; i < items; i++) {
-               char *name = SvPV_nolen (ST (i));
+               names[i-1] = SvPV_nolen (ST (i));
+       }
+
+       EXTEND (SP, items-1);
+       for (i = 0; i < items-1; i++) {
+               char *name = names[i];
                init_property_value (object, name, &value);
+               PUTBACK;
                g_object_get_property (object, name, &value);
+               SPAGAIN;
                PUSHs(sv_2mortal(_gperl_sv_from_value_internal(&value, TRUE)));
                g_value_unset (&value);
        }
 
+       g_free (names);
+
 
 =for apidoc Glib::Object::set
 =for signature $object->set (key => $value, ...)
Index: t/5.t
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/t/5.t,v
retrieving revision 1.7
diff -u -d -p -r1.7 5.t
--- t/5.t       9 Sep 2006 15:04:08 -0000       1.7
+++ t/5.t       31 Aug 2008 18:11:11 -0000
@@ -8,6 +8,7 @@
 
 use strict;
 use warnings;
+use Test::More; # for eq_array
 
 print "1..9\n";
 
@@ -45,7 +46,14 @@ sub FINALIZE_INSTANCE {
    print "ok 8\n";
 }
 
+sub grow_the_stack {
+  1 .. 500;
+}
+
 sub GET_PROPERTY {
+   # grow the stack to trigger reallocation and movement of it in order to test
+   # that Glib::Object->get handles the stack correctly
+   my @list = grow_the_stack();
    77;
 }
 
@@ -55,7 +63,8 @@ package main;
    my $my = new MyClass;
    $my->set(some_string => "xyz");
    print $my->{some_string} eq "xyz" ? "" : "not ", "ok 3\n";
-   print $my->get("some_string") == 77 ? "" : "not ", "ok 4\n";
+   print eq_array([$my->get("some_string", "some_string")], [77, 77])
+      ? "" : "not ", "ok 4\n";
 
 
    # verify that invalid property names result in an exception.