Implement uplevel()

[perl/modules/Scope-Upper.git] / t / 65-uplevel-multi.t

diff --git a/t/65-uplevel-multi.t b/t/65-uplevel-multi.t
new file mode 100644 (file)
index 0000000..c74815f
--- /dev/null
+++ b/t/65-uplevel-multi.t
@@ -0,0 +1,94 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 3 + 7 * 2 + 8;
+
+use Scope::Upper qw<uplevel HERE UP>;
+
+sub depth {
+ my $depth = 0;
+ while (1) {
+  my @c = caller($depth);
+  last unless @c;
+  ++$depth;
+ }
+ return $depth - 1;
+}
+
+is depth(),                           0, 'check top depth';
+is sub { depth() }->(),               1, 'check subroutine call depth';
+is do { local $@; eval { depth() } }, 1, 'check eval block depth';
+
+{
+ my $desc = 'uplevel in uplevel : lower frame';
+ local $@;
+ my @ret = eval {
+  1, sub {
+   is depth(), 2, "$desc: correct depth 1";
+   2, uplevel(sub {
+    is depth(), 2, "$desc: correct depth 2";
+    3, sub {
+     is depth(), 3, "$desc: correct depth 3";
+     4, uplevel(sub {
+      is depth(), 3, "$desc: correct depth 4";
+      return 5, @_;
+     }, 6, @_, HERE);
+    }->(7, @_);
+   }, 8, @_, HERE);
+  }->(9);
+ };
+ is $@,      '',              "$desc: no error";
+ is depth(), 0,               "$desc: correct depth outside";
+ is_deeply \@ret, [ 1 .. 9 ], "$desc: correct return value"
+}
+
+{
+ my $desc = 'uplevel in uplevel : same frame';
+ local $@;
+ my @ret = eval {
+  11, sub {
+   is depth(), 2, "$desc: correct depth 1";
+   12, uplevel(sub {
+    is depth(), 2, "$desc: correct depth 2";
+    13, sub {
+     is depth(), 3, "$desc: correct depth 3";
+     14, uplevel(sub {
+      is depth(), 2, "$desc: correct depth 4";
+      return 15, @_;
+     }, 16, @_, UP);
+    }->(17, @_);
+   }, 18, @_, HERE);
+  }->(19);
+ };
+ is $@,      '',                "$desc: no error";
+ is depth(), 0,                 "$desc: correct depth outside";
+ is_deeply \@ret, [ 11 .. 19 ], "$desc: correct return value"
+}
+
+{
+ my $desc = 'uplevel in uplevel : higher frame';
+ local $@;
+ my @ret = eval {
+  20, sub {
+   is depth(), 2, "$desc: correct depth 1";
+   21, sub {
+    is depth(), 3, "$desc: correct depth 2";
+    22, uplevel(sub {
+     is depth(), 3, "$desc: correct depth 3";
+     23, sub {
+      is depth(), 4, "$desc: correct depth 4";
+      24, uplevel(sub {
+       is depth(), 2, "$desc: correct depth 5";
+       return 25, @_;
+      }, 26, @_, UP UP);
+     }->(27, @_);
+    }, 28, @_, HERE);
+   }->(29, @_);
+  }->('2A');
+ };
+ is $@,      '',                      "$desc: no error";
+ is depth(), 0,                       "$desc: correct depth outside";
+ is_deeply \@ret, [ 20 .. 29, '2A' ], "$desc: correct return value"
+}