From: Vincent Pit <vince@profvince.com>
Date: Sun, 18 Jan 2009 22:26:04 +0000 (+0100)
Subject: Fix segfaults that seems to happen when one croak in a callback at compile time
X-Git-Tag: v0.27~7
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=43fc5863659f79e6703fc2cb8b977eb75c3ffb4a;p=perl%2Fmodules%2FVariable-Magic.git

Fix segfaults that seems to happen when one croak in a callback at compile time
---

diff --git a/Magic.xs b/Magic.xs
index 38b27db..a092dbe 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -113,6 +113,10 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
 # define MGf_LOCAL 0
 #endif
 
+#ifndef IN_PERL_COMPILETIME
+# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
+#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)
 # define VMG_UVAR 1
@@ -237,6 +241,7 @@ STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, AV *args) {
 #define vmg_data_new(C, S, A) vmg_data_new(aTHX_ (C), (S), (A))
  SV *nsv;
  I32 i, alen = (args == NULL) ? 0 : av_len(args);
+ I32 flags = G_SCALAR;
 
  dSP;
  int count;
@@ -251,7 +256,10 @@ STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, AV *args) {
   PUSHs(*av_fetch(args, i, 0));
  PUTBACK;
 
- count = call_sv(ctor, G_SCALAR);
+ if (IN_PERL_COMPILETIME)
+  flags |= G_EVAL | G_KEEPERR;
+
+ count = call_sv(ctor, flags);
 
  SPAGAIN;
 
@@ -463,6 +471,7 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data, unsigned int args, ...) {
  SV *svr;
  int ret;
  unsigned int i;
+ I32 flags = G_SCALAR;
 
  dSP;
  int count;
@@ -482,7 +491,10 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data, unsigned int args, ...) {
  va_end(ap);
  PUTBACK;
 
- count = call_sv(cb, G_SCALAR);
+ if (IN_PERL_COMPILETIME)
+  flags |= G_EVAL | G_KEEPERR;
+
+ count = call_sv(cb, flags);
 
  SPAGAIN;
 
@@ -514,6 +526,7 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
  SV *svr;
  I32 len, has_array;
  U32 ret;
+ I32 flags = G_SCALAR;
 
  dSP;
  int count;
@@ -536,7 +549,10 @@ STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
  }
  PUTBACK;
 
- count = call_sv(SV2MGWIZ(mg->mg_ptr)->cb_len, G_SCALAR);
+ if (IN_PERL_COMPILETIME)
+  flags |= G_EVAL | G_KEEPERR;
+
+ count = call_sv(SV2MGWIZ(mg->mg_ptr)->cb_len, flags);
 
  SPAGAIN;