Compatibility fix for 5.11.1

[perl/modules/Variable-Magic.git] / Magic.xs

diff --git a/Magic.xs b/Magic.xs
index c2d8f6542f5c4af09941fd04f4aea404502d5728..628bf5666c8602338f06db61241facbc58479de9 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -36,6 +36,11 @@
 # 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
@@ -135,20 +140,32 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
 # 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
+/* This branch should only apply for perls before the official 5.11.0 release.
+ * Makefile.PL takes care of the higher ones. */
 #  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 */
@@ -812,8 +829,9 @@ STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
 
 STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
  const MGWIZ *w;
-#if VMG_HAS_PERL(5, 10, 0)
+#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;
@@ -852,19 +870,21 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
  if (had_err)
   flags |= G_KEEPERR;
 
-#if VMG_HAS_PERL(5, 10, 0)
+#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)
-  Perl_cxinc(aTHX);
- saved_cx = cxstack[cxstack_ix + 1];
+ 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, 10, 0)
- cxstack[cxstack_ix + 1] = saved_cx;
+#if VMG_HAS_PERL(5, 9, 5)
+ cxstack[cxix] = saved_cx;
 #endif
 
  has_err = SvTRUE(ERRSV);
@@ -876,18 +896,6 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
  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;
-  if (cxstack_ix >= cxstack_max)
-   Perl_cxinc(aTHX);
-  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);
@@ -1263,6 +1271,8 @@ BOOT:
  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",
@@ -1271,6 +1281,7 @@ BOOT:
                     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));
 }
@@ -1476,7 +1487,7 @@ PPCODE:
  sig  = vmg_wizard_sig(wiz);
  data = vmg_data_get(SvRV(sv), sig);
  if (!data)
-  XSRETURN_UNDEF;
+  XSRETURN_EMPTY;
  ST(0) = data;
  XSRETURN(1);