]> git.vpit.fr Git - perl/modules/Scope-Upper.git/commitdiff
Sanitize and check unwind targets
authorVincent Pit <vince@profvince.com>
Sun, 11 Jan 2009 15:31:56 +0000 (16:31 +0100)
committerVincent Pit <vince@profvince.com>
Sun, 11 Jan 2009 15:31:56 +0000 (16:31 +0100)
MANIFEST
Upper.xs
t/50-unwind-target.t [new file with mode: 0644]

index ac7270b93cbd0cd808b9613af2494a2aa1465a79..d0a11d47fa3ec9e91aa1574395bed28f7d1cbd84 100644 (file)
--- 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
index 53dd22f41af57ed9c7aa1c6734eb27532a1c9e21..231acccc4dbf105c942243cdb2502a5cf28f4ea9 100644 (file)
--- 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 (file)
index 0000000..35ca97e
--- /dev/null
@@ -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)';