| Subject: | Segfault during global destruction |
This simple program segfauls on HP-UX LP64 builds:
$ENV{PERL_DESTRUCT_LEVEL} = 1;
use Tk;
MainWindow->new;
We applied the following patch to the ActivePerl/PPM builds of Tk. Please consider it for the official version.
We applied the following patch to the ActivePerl/PPM builds of Tk. Please consider it for the official version.
| Subject: | Tk-804.030.patch |
From 60a791b8bd81442e49033228738a425e2d73e94f Mon Sep 17 00:00:00 2001
From: Gisle Aas <gisle@activestate.com>
Date: Sat, 16 Mar 2013 02:40:55 -0700
Subject: [PATCH] Avoid segfaults during global destruction [p4:120271]
In pTk the Tcl_Obj objects are Perl SVs in the following layout:
Tcl_Obj
sv xpvmg
+-------+ +-------+
|ANY O---->|PVX |
+-------+ +-------+
|REFCNT | |CUR |
+-------+ +-------+
| |T| |LEN |
+-------+ +-------+
|IVX |
+-------+
|NVX | magic
+-------+ +-------+
|MAGIC O--->| |
+-------+ +-------+
|STASH | |VIRTUAL|
+-------+ +-------+
| |~| | sv xpv TclObjMagic_t
+-------+ +-------+ +-------+ +-----------+
| obj O---->| 0---->|PVX 0---->|type |
+-------+ +-------+ +-------+ +-----------+
| | | | |CUR | |internalRep|
+-------+ +-------+ +-------+ +-----------+
| | | |T| |LEN |
+-------+ +-------+ +-------+
The string or numeric value is picked up from PVX, IVX, NVX as normal
but anything else goes via the '~'-magic to a separate SV that holds a
struct that point to the Tcl_ObjType and Tcl_InternalRep.
This arrangement is problematic for those Tcl_Obj objects that survive
to be killed by the perl's sweep&destroy during global destruction.
What might happen at this point is that the internal magical SV is
killed before the Tcl_Obj itself. In this case we loose the Tcl type
info and internalRep, and we are not able to clean that part up
properly.
This patch disarm the VIRTUAL svt_free function for Tcl_Obj so that it
doesn't try to dereference the internal SV when it has already been
killed.
This should fix the seg faults we have experienced on the 64 bit HP-UX
builds for tests that use Test::More. The problem actually exists on
all platforms but only on HP-UX have we been unlucky enough for the
garbage type info to have a non-zero 'freeIntRepProc'.
Failed 5/47 test scripts, 89.36% okay. 0/2054 subtests failed, 100.00% okay.
Failed Test Stat Wstat Total Fail Failed List of Failed
-------------------------------------------------------------------------------
t/after.t 0 138 6 0 0.00% ??
t/button.t 0 138 3 0 0.00% ??
t/regexp.t 0 138 21 0 0.00% ??
t/wm-time.t 0 138 6 0 0.00% ??
t/wm.t 0 138 1 0 0.00% ??
(3 subtests UNEXPECTEDLY SUCCEEDED), 2 tests and 23 subtests skipped.
The reason 'Test::More' was needed is that it will load threads.pm for
ithreads-enabled perls and 'threads.pm will set PL_perl_destruct_level
to 1, which triggers the sweep&destroy of all SVs when perl terminates.
This is an even simpler test case that segfaults on HP-UX LP64 builds
without this patch:
$ENV{PERL_DESTRUCT_LEVEL} = 1;
use Tk;
MainWindow->new;
---
objGlue.c | 12 +++++++++++-
1 files changed, 11 insertions(+), 1 deletions(-)
diff --git a/objGlue.c b/objGlue.c
index 7128e7b..71eb224 100644
--- a/objGlue.c
+++ b/objGlue.c
@@ -1405,7 +1405,17 @@ TclObj_get(pTHX_ SV *sv, MAGIC *mg)
static int
TclObj_free(pTHX_ SV *sv, MAGIC *mg)
{
- TclObjMagic_t *info = (TclObjMagic_t *)SvPVX(mg->mg_obj);
+ TclObjMagic_t * info;
+ if (SvTYPE(mg->mg_obj) == SVTYPEMASK)
+ {
+ /* Oops!! Our magic info SV has already been sweeped away
+ * during global destruction. In this case we might leak
+ * some the stuff hanging off the Tcl_InternalRep, but there
+ * are not really much more we can do here.
+ */
+ return;
+ }
+ info = (TclObjMagic_t *)SvPVX(mg->mg_obj);
if (info->type)
{
#ifdef DEBUG_TCLOBJ
--
1.7.0.5