From: Vincent Pit <vince@profvince.com>
Date: Sun, 11 Jan 2009 15:31:56 +0000 (+0100)
Subject: Sanitize and check unwind targets
X-Git-Tag: v0.04~8
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=f0bcaf18260322fd0bc7ebe1bcae0cff45681a4d

Sanitize and check unwind targets
---

diff --git a/MANIFEST b/MANIFEST
index ac7270b..d0a11d4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -24,6 +24,7 @@ t/34-localize_elem-magic.t
 t/40-localize_delete-target.t
 t/41-localize_delete-level.t
 t/44-localize_delete-magic.t
+t/50-unwind-target.t
 t/53-unwind-context.t
 t/55-unwind-multi.t
 t/81-stress-level.t
diff --git a/Upper.xs b/Upper.xs
index 53dd22f..231accc 100644
--- a/Upper.xs
+++ b/Upper.xs
@@ -533,7 +533,8 @@ STATIC void su_unwind(pTHX_ void *ud_) {
   dounwind(cxix);
 
  /* Hide the level */
- PL_stack_sp--;
+ if (items >= 0)
+  PL_stack_sp--;
 
  mark = PL_markstack[cxstack[cxix].blk_oldmarksp];
 
@@ -597,20 +598,19 @@ XS(XS_Scope__Upper_unwind) {
 #else
  dXSARGS;
 #endif
- I32 cxix;
+ I32 from = 0, cxix = cxstack_ix;
  su_ud_unwind *ud;
  SV *level;
- if (!items)
-  Perl_croak(aTHX_ "Usage: Scope::Upper::unwind(..., level)");
  PERL_UNUSED_VAR(cv); /* -W */
  PERL_UNUSED_VAR(ax); /* -Wall */
- level = ST(items - 1);
- cxix = SvOK(level) ? SvIV(level) : 0;
- if (cxix < 0)
-  cxix = 0;
- else if (cxix > cxstack_ix)
-  cxix = cxstack_ix;
- cxix = cxstack_ix - cxix;
+ if (items) {
+  from = SvIV(ST(items - 1));
+  if (from < 0)
+   from = 0;
+  else if (from > cxix)
+   from = cxix;
+ }
+ cxix -= from;
  do {
   PERL_CONTEXT *cx = cxstack + cxix;
   switch (CxTYPE(cx)) {
diff --git a/t/50-unwind-target.t b/t/50-unwind-target.t
new file mode 100644
index 0000000..35ca97e
--- /dev/null
+++ b/t/50-unwind-target.t
@@ -0,0 +1,29 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use Scope::Upper qw/unwind/;
+
+my @res;
+
+@res = (7, eval {
+ unwind;
+ 8;
+});
+is_deeply \@res, [ 7 ], 'unwind()';
+
+@res = (7, eval {
+ unwind -1;
+ 8;
+});
+is_deeply \@res, [ 7 ], 'unwind(-1)';
+
+@res = (7, eval {
+ unwind 100;
+ 8;
+});
+like $@, qr/^Can't\s+return\s+outside\s+a\s+subroutine/, 'unwind(100)';
+is_deeply \@res, [ 7 ], 'unwind(100)';