# define dNOOP
#endif
+/* Safe unless stated otherwise in Makefile.PL */
+#ifndef VMG_FORKSAFE
+# define VMG_FORKSAFE 1
+#endif
+
#ifndef VMG_MULTIPLICITY
# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT)
# define VMG_MULTIPLICITY 1
# endif
#endif
-/* uvar magic and Hash::Util::FieldHash were commited with 28419 */
-#if VMG_HAS_PERL_MAINT(5, 9, 4, 28419) || VMG_HAS_PERL(5, 10, 0)
+/* uvar magic and Hash::Util::FieldHash were commited with 28419, but only
+ * enable it on 5.10 */
+#if VMG_HAS_PERL(5, 10, 0)
# define VMG_UVAR 1
#else
# define VMG_UVAR 0
#endif
-/* Applied to dev-5.9 as 25854, integrated to maint-5.8 as 28160 */
-#ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN
-# if VMG_HAS_PERL_MAINT(5, 8, 9, 28160) || VMG_HAS_PERL_MAINT(5, 9, 3, 25854) || VMG_HAS_PERL(5, 10, 0)
+/* Applied to dev-5.9 as 25854, integrated to maint-5.8 as 28160, partially
+ * reverted to dev-5.11 as 9cdcb38b */
+#if VMG_HAS_PERL_MAINT(5, 8, 9, 28160) || VMG_HAS_PERL_MAINT(5, 9, 3, 25854) || VMG_HAS_PERL(5, 10, 0)
+# ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN
# define VMG_COMPAT_ARRAY_PUSH_NOLEN 1
-# else
+# endif
+# ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID
+# define VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID 1
+# endif
+#else
+# ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN
# define VMG_COMPAT_ARRAY_PUSH_NOLEN 0
# endif
+# ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID
+# define VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID 0
+# endif
#endif
/* Applied to dev-5.11 as 34908 */
STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
const MGWIZ *w;
+#if VMG_HAS_PERL(5, 9, 5)
+ PERL_CONTEXT saved_cx;
+ I32 cxix;
+#endif
unsigned int had_err, has_err, flags = G_SCALAR | G_EVAL;
int ret = 0;
if (had_err)
flags |= G_KEEPERR;
+#if VMG_HAS_PERL(5, 9, 5)
+ /* This context should not be used anymore, but since we croak in places the
+ * core doesn't even dare to, some pointers to it may remain in the upper call
+ * stack. Make sure call_sv() doesn't clobber it. */
+ if (cxstack_ix < cxstack_max)
+ cxix = cxstack_ix + 1;
+ else
+ cxix = Perl_cxinc(aTHX);
+ saved_cx = cxstack[cxix];
+#endif
+
call_sv(w->cb_free, flags);
+#if VMG_HAS_PERL(5, 9, 5)
+ cxstack[cxix] = saved_cx;
+#endif
+
has_err = SvTRUE(ERRSV);
if (IN_PERL_COMPILETIME && !had_err && has_err)
++PL_error_count;
FREETMPS;
LEAVE;
- if (has_err) {
- /* Get the eval context that was pushed by call_sv, and fake an entry for the
- * namesv, as die_where will need it to be non NULL later */
- PERL_CONTEXT *cx = cxstack + cxstack_ix + 1;
- if (!cx->blk_eval.old_namesv)
- cx->blk_eval.old_namesv
- = sv_2mortal(newSVpvn_share("Variable/Magic/DUMMY.pm", 23, 0));
- }
-
/* Calling SvREFCNT_dec() will trigger destructors in an infinite loop, so
* we have to rely on SvREFCNT() being a lvalue. Heck, even the core does it */
--SvREFCNT(sv);
if (hv_delete(MY_CXT.wizards, buf, sprintf(buf, "%u", w->sig), 0) != wiz)
return 0;
}
- SvFLAGS(wiz) |= SVf_BREAK;
- FREETMPS;
+
+ /* Unmortalize the wizard to avoid it being freed in weird places. */
+ if (SvTEMP(wiz) && !SvREFCNT(wiz)) {
+ const I32 myfloor = PL_tmps_floor;
+ I32 i;
+ for (i = PL_tmps_ix; i > myfloor; --i) {
+ if (PL_tmps_stack[i] == wiz)
+ PL_tmps_stack[i] = NULL;
+ }
+ }
if (w->cb_data) SvREFCNT_dec(SvRV(w->cb_data));
if (w->cb_get) SvREFCNT_dec(SvRV(w->cb_get));
newCONSTSUB(stash, "VMG_UVAR", newSVuv(VMG_UVAR));
newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN",
newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN));
+ newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID",
+ newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID));
newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID",
newSVuv(VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID));
newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNDEF_CLEAR",
newSVuv(VMG_COMPAT_SCALAR_LENGTH_NOLEN));
newCONSTSUB(stash, "VMG_PERL_PATCHLEVEL", newSVuv(VMG_PERL_PATCHLEVEL));
newCONSTSUB(stash, "VMG_THREADSAFE", newSVuv(VMG_THREADSAFE));
+ newCONSTSUB(stash, "VMG_FORKSAFE", newSVuv(VMG_FORKSAFE));
newCONSTSUB(stash, "VMG_OP_INFO_NAME", newSVuv(VMG_OP_INFO_NAME));
newCONSTSUB(stash, "VMG_OP_INFO_OBJECT", newSVuv(VMG_OP_INFO_OBJECT));
}
sig = vmg_wizard_sig(wiz);
data = vmg_data_get(SvRV(sv), sig);
if (!data)
- XSRETURN_UNDEF;
+ XSRETURN_EMPTY;
ST(0) = data;
XSRETURN(1);