← Back to branch summary

~ubuntu-branches/ubuntu/quantal/libglib-perl/quantal

« back to all changes in this revision

Viewing changes to GObject.xs

  • Committer: Package Import Robot
  • Author(s): Alessandro Ghedini
  • Date: 2012-03-02 15:35:04 UTC
  • mfrom: (9.1.5 sid)
  • Revision ID: package-import@ubuntu.com-20120302153504-4abua3qbwpfh27g6
Tags: 2:1.251-1
* New upstream release
* Drop fix-pod-spelling.patch (merged upstream)
* Update upstream copyright years
* Bump debhelper compat level to 9
* Update debian/copyright format as in Debian Policy 3.9.3
* Bump Standards-Version to 3.9.3
* Fix upstream copyirght holder
* Use NEWS file as upstream changelog

Show diffs side-by-side

added added

removed removed

Lines of Context:
GObject.xs
1
1
/*
2
 
 * Copyright (C) 2003-2006, 2010 by the gtk2-perl team (see the file AUTHORS for
3
 
 * the full list)
 
2
 * Copyright (C) 2003-2006, 2010, 2012 by the gtk2-perl team (see the file
 
3
 * AUTHORS for the full list)
4
4
 *
5
5
 * This library is free software; you can redistribute it and/or modify it
6
6
 * under the terms of the GNU Library General Public License as published by
14
14
 *
15
15
 * You should have received a copy of the GNU Library General Public License
16
16
 * along with this library; if not, write to the Free Software Foundation,
17
 
 * Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307  USA.
 
17
 * Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
18
 *
19
19
 * $Id$
20
20
 */
135
135
        return NULL;
136
136
}
137
137
 
 
138
/* copied from ppport.h, needed for older perls (< 5.8.8?) */
 
139
#ifndef SvMAGIC_set
 
140
#  define SvMAGIC_set(sv, val)           \
 
141
                STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
 
142
                (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
 
143
#endif
 
144
 
138
145
/*
139
146
 * Remove the association between a pointer attached to C<sv> using
140
147
 * C<_gperl_attach_mg> and the C<sv>.
776
783
{
777
784
        GPERL_SET_CONTEXT;
778
785
 
779
 
        if (PL_in_clean_objs)
780
 
                return;
 
786
        /* As of perl 5.16, this function needs to run even during global
 
787
         * destruction (i.e. when PL_in_clean_objs is true) since we might
 
788
         * otherwise end up with undead HVs hanging on to garbage.  Prior to
 
789
         * 5.16, this did not matter, but recent versions of perl will find
 
790
         * these HVs and call DESTROY on them. */
781
791
 
782
792
#ifdef NOISY
783
793
        warn ("gobject_destroy_wrapper (%p)[%d]\n", obj,
1206
1216
 
1207
1217
void
1208
1218
DESTROY (SV *sv)
 
1219
    PREINIT:
 
1220
        GObject *object;
 
1221
        gboolean was_undead;
1209
1222
    CODE:
1210
 
        GObject *object = gperl_get_object (sv);
1211
 
 
1212
 
        if (!object) /* Happens on object destruction. */
 
1223
        object = gperl_get_object (sv);
 
1224
        if (!object) /* Happens on GObject destruction. */
1213
1225
                return;
1214
1226
#ifdef NOISY
1215
1227
        warn ("DESTROY< (%p)[%d] => %s (%p)[%d]\n",
1217
1229
              gperl_object_package_from_type (G_OBJECT_TYPE (object)),
1218
1230
              sv, SvREFCNT (SvRV(sv)));
1219
1231
#endif
 
1232
        was_undead = IS_UNDEAD (g_object_get_qdata (object, wrapper_quark));
1220
1233
        /* gobject object still exists, so take back the refcount we lend it. */
1221
1234
        /* this operation does NOT change the refcount of the combined object. */
1222
 
 
1223
1235
        if (PL_in_clean_objs) {
1224
1236
                /* be careful during global destruction. basically,
1225
1237
                 * don't bother, since refcounting is no longer meaningful. */
1226
1238
                _gperl_remove_mg (SvRV (sv));
1227
 
 
1228
1239
                g_object_steal_qdata (object, wrapper_quark);
1229
1240
        } else {
1230
1241
                SvREFCNT_inc (SvRV (sv));
1256
1267
                G_UNLOCK (perl_gobjects);
1257
1268
        }
1258
1269
#endif
1259
 
        g_object_unref (object);
 
1270
        /* As of perl 5.16, even HVs that are not referenced by any SV will get
 
1271
         * their DESTROY called during global destruction.  Such HVs can occur
 
1272
         * when the GObject outlives the HV, as for GtkWindow or GdkScreen.
 
1273
         * Here in DESTROY such an HV will be in the "undead" state and will
 
1274
         * not own a reference to the GObject anymore.  Thus we need to avoid
 
1275
         * calling unref in this case.  See
 
1276
         * <https://rt.perl.org/rt3//Public/Bug/Display.html?id=36347> for the
 
1277
         * perl change. */
 
1278
        if (!was_undead) {
 
1279
                g_object_unref (object);
 
1280
        }
1260
1281
#ifdef NOISY
1261
1282
        warn ("DESTROY> (%p) done\n", object);
1262
1283
        /*