From: Vincent Pit <vince@profvince.com>
Date: Thu, 15 Apr 2010 21:44:02 +0000 (+0200)
Subject: Also apply the context overwrite workaround when not under OP_DIE
X-Git-Tag: rt56301^0
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=4825a3233b7d55ceb3e7f5d812fd6a545b3b87ce

Also apply the context overwrite workaround when not under OP_DIE

This fixes RT #56301.
---

diff --git a/Upper.xs b/Upper.xs
index 42f457e..bb1150c 100644
--- a/Upper.xs
+++ b/Upper.xs
@@ -283,7 +283,6 @@ STATIC void su_call(pTHX_ void *ud_) {
  su_ud_reap *ud = (su_ud_reap *) ud_;
 #if SU_HAS_PERL(5, 9, 5)
  PERL_CONTEXT saved_cx;
- I32 dieing = PL_op->op_type == OP_DIE;
  I32 cxix;
 #endif
 
@@ -305,20 +304,17 @@ STATIC void su_call(pTHX_ void *ud_) {
   * the sub scope from call_sv, although it's still needed in our caller. */
 
 #if SU_HAS_PERL(5, 9, 5)
- if (dieing) {
-  if (cxstack_ix < cxstack_max)
-   cxix = cxstack_ix + 1;
-  else
-   cxix = Perl_cxinc(aTHX);
-  saved_cx = cxstack[cxix];
- }
+ if (cxstack_ix < cxstack_max)
+  cxix = cxstack_ix + 1;
+ else
+  cxix = Perl_cxinc(aTHX);
+ saved_cx = cxstack[cxix];
 #endif
 
  call_sv(ud->cb, G_VOID);
 
 #if SU_HAS_PERL(5, 9, 5)
- if (dieing)
-  cxstack[cxix] = saved_cx;
+ cxstack[cxix] = saved_cx;
 #endif
 
  PUTBACK;
diff --git a/t/13-reap-ctl.t b/t/13-reap-ctl.t
index 210b5b5..39a0bb4 100644
--- a/t/13-reap-ctl.t
+++ b/t/13-reap-ctl.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 38 + 30 + 4 * 7;
+use Test::More tests => 41 + 30 + 4 * 7;
 
 use Scope::Upper qw/reap UP HERE/;
 
@@ -122,6 +122,19 @@ $y = undef;
  is $y, 1, 'die - reap inside eval [ok - y]';
 }
 
+{
+ my $z      = 0;
+ my $reaped = 0;
+ eval {
+  reap { $reaped = 1 };
+  is $reaped, 0, 'died of natural death - not reaped yet';
+  my $res = 1 / $z;
+ };
+ my $err = $@;
+ is   $reaped, 1,                    'died of natural death - reaped';
+ like $err,    qr/division by zero/, 'died of natural death - divided by zero';
+}
+
 SKIP:
 {
  skip 'Perl 5.10 required to test given/when' => 30 if $] < 5.010;