Fix uplevel() recalling into an XSUB

[perl/modules/Scope-Upper.git] / t / 61-uplevel-args.t

diff --git a/t/61-uplevel-args.t b/t/61-uplevel-args.t
index 5ef1f8324c09785ad09a6156ef255ac5b0e63ba6..f6955adfbf821339eb798ef3ee8b3c9ffdfd67b9 100644 (file)
--- a/t/61-uplevel-args.t
+++ b/t/61-uplevel-args.t
@@ -3,45 +3,46 @@
 use strict;
 use warnings;
 
-use Test::More tests => 9 + 4 * 7 + 3 + ((5 * 4 * 4) * 3 + 1) + 2 + 6;
+use Test::More tests => 9 + 4 * 7 + 3 + ((5 * 4 * 4) * 3 + 1) + 3 + 2 + 6;
 
-use Scope::Upper qw<uplevel HERE>;
+use Scope::Upper qw<uplevel HERE UP>;
 
 # Basic
 
 sub {
  uplevel { pass 'no @_: callback' };
- is_deeply \@_, [ 'dummy' ], 'no @_: @_ outside';
+ is "@_", 'dummy', 'no @_: @_ outside';
 }->('dummy');
 
 sub {
- uplevel { is_deeply \@_, [ ], "no arguments, no context" }
+ uplevel { is "@_", '', "no arguments, no context" }
 }->('dummy');
 
 sub {
- uplevel { is_deeply \@_, [ ], "no arguments, with context" } HERE
+ uplevel { is "@_", '', "no arguments, with context" } HERE
 }->('dummy');
 
 sub {
- uplevel { is_deeply \@_, [ 1 ], "one const argument" } 1, HERE
+ uplevel { is "@_", '1', "one const argument" } 1, HERE
 }->('dummy');
 
 my $x = 2;
 sub {
- uplevel { is_deeply \@_, [ 2 ], "one lexical argument" } $x, HERE
+ uplevel { is "@_", '2', "one lexical argument" } $x, HERE
 }->('dummy');
 
 our $y = 3;
 sub {
- uplevel { is_deeply \@_, [ 3 ], "one global argument" } $y, HERE
+ uplevel { is "@_", '3', "one global argument" } $y, HERE
 }->('dummy');
 
 sub {
- uplevel { is_deeply \@_, [ 4, 5 ], "two const arguments" } 4, 5, HERE
+ uplevel { is "@_", '4 5', "two const arguments" } 4, 5, HERE
 }->('dummy');
 
 sub {
- uplevel { is_deeply \@_, [ 1 .. 10 ], "ten const arguments" } 1 .. 10, HERE
+ uplevel { is "@_", '1 2 3 4 5 6 7 8 9 10', "ten const arguments" }
+         1 .. 10 => HERE;
 }->('dummy');
 
 # Reification of @_
@@ -232,6 +233,29 @@ SKIP: {
  }->('dummy');
 }
 
+# uplevel() to uplevel()
+
+{
+ my $desc = '\&uplevel as the uplevel() callback';
+ local $@;
+ eval {
+  sub {
+   my $cxt = HERE;
+   sub {
+    sub {
+     # Note that an XS call does not need a context, so after the first uplevel
+     # call UP will point to the scope above the first target.
+     uplevel(\&uplevel => (sub {
+      is "@_", '1 2 3', "$desc: arguments inisde";
+      is HERE, $cxt,    "$desc: context inside";
+     } => 1 .. 3 => UP) => UP);
+    }->(10 .. 19);
+   }->(sub { die 'wut' } => HERE);
+  }->('dummy');
+ };
+ is $@, '', "$desc: no error";
+}
+
 # Magic
 
 {