X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Upper.xs;h=eb45c1f5faa2d3e2dfdddf5236c6695ed6eb7b59;hb=5dd48a401229e457106bdc30bb841e9fed0dde7c;hp=ca702bee12b2d86c1dd4ec660d766f76ac501fc4;hpb=aadd0157199345b7e2570fa1d45d998479691b5e;p=perl%2Fmodules%2FScope-Upper.git

diff --git a/Upper.xs b/Upper.xs
index ca702be..eb45c1f 100644
--- a/Upper.xs
+++ b/Upper.xs
@@ -1126,6 +1126,15 @@ STATIC void su_unwind(pTHX_ void *ud_) {
  PERL_UNUSED_VAR(ud_);
 
  PL_stack_sp = MY_CXT.unwind_storage.savesp;
+#if SU_HAS_PERL(5, 19, 4)
+ {
+  I32 i;
+  SV **sp = PL_stack_sp;
+  for (i = -items + 1; i <= 0; ++i)
+   if (!SvTEMP(sp[i]))
+    sv_2mortal(SvREFCNT_inc(sp[i]));
+ }
+#endif
 
  if (cxstack_ix > cxix)
   dounwind(cxix);
@@ -1301,6 +1310,15 @@ cxt_when:
  }
 
  PL_stack_sp = MY_CXT.yield_storage.savesp;
+#if SU_HAS_PERL(5, 19, 4)
+ {
+  I32 i;
+  SV **sp = PL_stack_sp;
+  for (i = -items + 1; i <= 0; ++i)
+   if (!SvTEMP(sp[i]))
+    sv_2mortal(SvREFCNT_inc(sp[i]));
+ }
+#endif
 
  if (cxstack_ix > cxix)
   dounwind(cxix);
@@ -2572,7 +2590,7 @@ PPCODE:
  cx   = cxstack + cxix;
  dbcx = cx;
  if (PL_DBsub && cxix && (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)) {
-  I32 i = su_context_skip_db(cxix - 1) + 1;;
+  I32 i = su_context_skip_db(cxix - 1) + 1;
   if (i < cxix && CxTYPE(cxstack + i) == CXt_SUB)
    cx = cxstack + i;
  }
@@ -2665,17 +2683,29 @@ PPCODE:
 #else
   SV *old_warnings = cop->cop_warnings;
 #endif
-  if (old_warnings == pWARN_NONE ||
-      (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0)) {
+  if (old_warnings == pWARN_STD) {
+   if (PL_dowarn & G_WARN_ON)
+    goto context_info_warnings_on;
+   else
+#if SU_HAS_PERL(5, 17, 4)
+    mask = &PL_sv_undef;
+#else
+    goto context_info_warnings_off;
+#endif
+  } else if (old_warnings == pWARN_NONE) {
+context_info_warnings_off:
    mask = su_newmortal_pvn(WARN_NONEstring, WARNsize);
-  } else if (old_warnings == pWARN_ALL ||
-             (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON)) {
-   HV *bits = get_hv("warnings::Bits", 0);
+  } else if (old_warnings == pWARN_ALL) {
+   HV *bits;
+context_info_warnings_on:
+#if SU_HAS_PERL(5, 8, 7)
+   bits = get_hv("warnings::Bits", 0);
    if (bits) {
     SV **bits_all = hv_fetchs(bits, "all", FALSE);
     if (bits_all)
      mask = sv_mortalcopy(*bits_all);
    }
+#endif
    if (!mask)
     mask = su_newmortal_pvn(WARN_ALLstring, WARNsize);
   } else {