Don't cleanup thread local storage before END blocks are executed

[perl/modules/indirect.git] / indirect.xs

diff --git a/indirect.xs b/indirect.xs
index 3bd5e6cef5addca2a46f23de0f07979c1152d5dc..db563796e6ce7681e03aabfafd9bd516c66c4cdd 100644 (file)
--- a/indirect.xs
+++ b/indirect.xs
@@ -63,6 +63,10 @@
 # define HvNAMELEN_get(H) strlen(HvNAME_get(H))
 #endif
 
+#ifndef OP_SIBLING
+# define OP_SIBLING(O) ((O)->op_sibling)
+#endif
+
 #define I_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
 
 #if I_HAS_PERL(5, 10, 0) || defined(PL_parser)
@@ -319,8 +323,6 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  ptable_hints_store(ud->tbl, ent->key, h2);
 }
 
-#include "reap.h"
-
 STATIC void indirect_thread_cleanup(pTHX_ void *ud) {
  dMY_CXT;
 
@@ -329,6 +331,29 @@ STATIC void indirect_thread_cleanup(pTHX_ void *ud) {
  ptable_hints_free(MY_CXT.tbl);
 }
 
+STATIC int indirect_endav_free(pTHX_ SV *sv, MAGIC *mg) {
+ SAVEDESTRUCTOR_X(indirect_thread_cleanup, NULL);
+
+ return 0;
+}
+
+STATIC MGVTBL indirect_endav_vtbl = {
+ 0,
+ 0,
+ 0,
+ 0,
+ indirect_endav_free
+#if MGf_COPY
+ , 0
+#endif
+#if MGf_DUP
+ , 0
+#endif
+#if MGf_LOCAL
+ , 0
+#endif
+};
+
 #endif /* I_THREADSAFE */
 
 #if I_WORKAROUND_REQUIRE_PROPAGATION
@@ -583,7 +608,8 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) {
      * when we already had a match because __PACKAGE__ can only appear in
      * direct method calls ("new __PACKAGE__" is a syntax error). */
     len = SvCUR(sv);
-    if (len == HvNAMELEN_get(PL_curstash)
+    if (PL_curstash
+        && len == (STRLEN) HvNAMELEN_get(PL_curstash)
         && memcmp(SvPVX(sv), HvNAME_get(PL_curstash), len) == 0) {
      STRLEN pos_pkg;
      SV    *pkg = sv_newmortal();
@@ -822,7 +848,7 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) {
     goto done;
    oop = lop->op_first;
   } while (oop->op_type != OP_PUSHMARK);
-  oop = oop->op_sibling;
+  oop = OP_SIBLING(oop);
   mop = lop->op_last;
 
   if (!oop)
@@ -990,6 +1016,7 @@ PROTOTYPE: DISABLE
 PREINIT:
  ptable *t;
  SV     *global_code_dup;
+ GV     *gv;
 PPCODE:
  {
   my_cxt_t ud;
@@ -1006,7 +1033,23 @@ PPCODE:
   MY_CXT.owner       = aTHX;
   MY_CXT.global_code = global_code_dup;
  }
- reap(3, indirect_thread_cleanup, NULL);
+ gv = gv_fetchpv(__PACKAGE__ "::_THREAD_CLEANUP", 0, SVt_PVCV);
+ if (gv) {
+  CV *cv = GvCV(gv);
+  if (!PL_endav)
+   PL_endav = newAV();
+  SvREFCNT_inc(cv);
+  if (!av_store(PL_endav, av_len(PL_endav) + 1, (SV *) cv))
+   SvREFCNT_dec(cv);
+  sv_magicext((SV *) PL_endav, NULL, PERL_MAGIC_ext, &indirect_endav_vtbl, NULL, 0);
+ }
+ XSRETURN(0);
+
+void
+_THREAD_CLEANUP(...)
+PROTOTYPE: DISABLE
+PPCODE:
+ indirect_thread_cleanup(aTHX_ NULL);
  XSRETURN(0);
 
 #endif