From: Vincent Pit Date: Fri, 28 Aug 2009 17:18:24 +0000 (+0200) Subject: Reset the callbacks when the root interpreter is destroyed X-Git-Tag: v0.19~3 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=commitdiff_plain;h=d237f88f7fb8be8d6836157872d5bf2b9ba02beb Reset the callbacks when the root interpreter is destroyed This fix segfaults when the pragma is first loaded from inside a thread. The global state for the root interpreter is also freed, so it won't leak anymore. --- diff --git a/MANIFEST b/MANIFEST index 8243e38..af5db83 100644 --- a/MANIFEST +++ b/MANIFEST @@ -17,6 +17,7 @@ t/22-bad-mixed.t t/23-bad-notaint.t t/30-scope.t t/40-threads.t +t/41-threads-teardown.t t/45-memory.t t/46-stress.t t/80-regressions.t diff --git a/indirect.xs b/indirect.xs index f928fdc..53cff20 100644 --- a/indirect.xs +++ b/indirect.xs @@ -767,6 +767,82 @@ done: STATIC U32 indirect_initialized = 0; +STATIC void indirect_teardown(pTHX_ void *root) { +#define indirect_teardown() indirect_teardown(aTHX) + dMY_CXT; + + if (!indirect_initialized) + return; + +#if I_MULTIPLICITY + if (aTHX != root) + return; +#endif + + ptable_free(MY_CXT.map); +#if I_THREADSAFE + ptable_hints_free(MY_CXT.tbl); +#endif + + PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_old_ck_const); + indirect_old_ck_const = 0; + PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_old_ck_rv2sv); + indirect_old_ck_rv2sv = 0; + PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_old_ck_padany); + indirect_old_ck_padany = 0; + PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_old_ck_scope); + indirect_old_ck_scope = 0; + PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_old_ck_lineseq); + indirect_old_ck_lineseq = 0; + + PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_old_ck_method); + indirect_old_ck_method = 0; + PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_old_ck_entersub); + indirect_old_ck_entersub = 0; + + indirect_initialized = 0; +} + +STATIC void indirect_setup(pTHX) { +#define indirect_setup() indirect_setup(aTHX) + if (indirect_initialized) + return; + + MY_CXT_INIT; +#if I_THREADSAFE + MY_CXT.tbl = ptable_new(); + MY_CXT.owner = aTHX; +#endif + MY_CXT.map = ptable_new(); + MY_CXT.linestr = NULL; + + indirect_old_ck_const = PL_check[OP_CONST]; + PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_ck_const); + indirect_old_ck_rv2sv = PL_check[OP_RV2SV]; + PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_ck_rv2sv); + indirect_old_ck_padany = PL_check[OP_PADANY]; + PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_ck_padany); + indirect_old_ck_scope = PL_check[OP_SCOPE]; + PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_ck_scope); + indirect_old_ck_lineseq = PL_check[OP_LINESEQ]; + PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_ck_scope); + + indirect_old_ck_method = PL_check[OP_METHOD]; + PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_ck_method); + indirect_old_ck_entersub = PL_check[OP_ENTERSUB]; + PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_ck_entersub); + +#if I_MULTIPLICITY + call_atexit(indirect_teardown, aTHX); +#else + call_atexit(indirect_teardown, NULL); +#endif + + indirect_initialized = 1; +} + +STATIC U32 indirect_booted = 0; + /* --- XS ------------------------------------------------------------------ */ MODULE = indirect PACKAGE = indirect @@ -775,38 +851,16 @@ PROTOTYPES: ENABLE BOOT: { - if (!indirect_initialized++) { + if (!indirect_booted++) { HV *stash; - MY_CXT_INIT; -#if I_THREADSAFE - MY_CXT.tbl = ptable_new(); - MY_CXT.owner = aTHX; -#endif - MY_CXT.map = ptable_new(); - MY_CXT.linestr = NULL; - PERL_HASH(indirect_hash, __PACKAGE__, __PACKAGE_LEN__); - indirect_old_ck_const = PL_check[OP_CONST]; - PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_ck_const); - indirect_old_ck_rv2sv = PL_check[OP_RV2SV]; - PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_ck_rv2sv); - indirect_old_ck_padany = PL_check[OP_PADANY]; - PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_ck_padany); - indirect_old_ck_scope = PL_check[OP_SCOPE]; - PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_ck_scope); - indirect_old_ck_lineseq = PL_check[OP_LINESEQ]; - PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_ck_scope); - - indirect_old_ck_method = PL_check[OP_METHOD]; - PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_ck_method); - indirect_old_ck_entersub = PL_check[OP_ENTERSUB]; - PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_ck_entersub); - stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1); newCONSTSUB(stash, "I_THREADSAFE", newSVuv(I_THREADSAFE)); } + + indirect_setup(); } #if I_THREADSAFE diff --git a/t/41-threads-teardown.t b/t/41-threads-teardown.t new file mode 100644 index 0000000..d8a6fc9 --- /dev/null +++ b/t/41-threads-teardown.t @@ -0,0 +1,59 @@ +#!perl + +use strict; +use warnings; + +use Config qw/%Config/; + +BEGIN { + if (!$Config{useithreads}) { + require Test::More; + Test::More->import; + plan(skip_all => 'This perl wasn\'t built to support threads'); + } +} + +use threads; + +use Test::More; + +BEGIN { + delete $ENV{PERL_INDIRECT_PM_DISABLE}; + require indirect; + if (indirect::I_THREADSAFE()) { + plan tests => 1; + defined and diag "Using threads $_" for $threads::VERSION; + } else { + plan skip_all => 'This indirect isn\'t thread safe'; + } +} + +sub run_perl { + my $code = shift; + + local %ENV; + system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code; +} + +SKIP: +{ + skip 'Fails on 5.8.2 and lower' => 1 if $] <= 5.008002; + + my $status = run_perl <<' RUN'; + my ($code, @expected); + BEGIN { + $code = 2; + @expected = qw/X Z/; + } + sub cb { --$code if $_[0] eq shift(@expected) || q{DUMMY} } + use threads; + $code = threads->create(sub { + eval q{return; no indirect hook => \&cb; new X;}; + return $code; + })->join; + eval q{new Y;}; + eval q{return; no indirect hook => \&cb; new Z;}; + exit $code; + RUN + is $status, 0, 'loading the pragma in a thread and using it outside doesn\'t segfault'; +}