t/65-uplevel-multi.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 3 + 7 * 2 + 8;
   7
   8 use Scope::Upper qw<uplevel HERE UP>;
   9
  10 sub depth {
  11  my $depth = 0;
  12  while (1) {
  13   my @c = caller($depth);
  14   last unless @c;
  15   ++$depth;
  16  }
  17  return $depth - 1;
  18 }
  19
  20 is depth(),                           0, 'check top depth';
  21 is sub { depth() }->(),               1, 'check subroutine call depth';
  22 is do { local $@; eval { depth() } }, 1, 'check eval block depth';
  23
  24 {
  25  my $desc = 'uplevel in uplevel : lower frame';
  26  local $@;
  27  my @ret = eval {
  28   1, sub {
  29    is depth(), 2, "$desc: correct depth 1";
  30    2, uplevel(sub {
  31     is depth(), 2, "$desc: correct depth 2";
  32     3, sub {
  33      is depth(), 3, "$desc: correct depth 3";
  34      4, uplevel(sub {
  35       is depth(), 3, "$desc: correct depth 4";
  36       return 5, @_;
  37      }, 6, @_, HERE);
  38     }->(7, @_);
  39    }, 8, @_, HERE);
  40   }->(9);
  41  };
  42  is $@,      '',              "$desc: no error";
  43  is depth(), 0,               "$desc: correct depth outside";
  44  is_deeply \@ret, [ 1 .. 9 ], "$desc: correct return value"
  45 }
  46
  47 {
  48  my $desc = 'uplevel in uplevel : same frame';
  49  local $@;
  50  my @ret = eval {
  51   11, sub {
  52    is depth(), 2, "$desc: correct depth 1";
  53    12, uplevel(sub {
  54     is depth(), 2, "$desc: correct depth 2";
  55     13, sub {
  56      is depth(), 3, "$desc: correct depth 3";
  57      14, uplevel(sub {
  58       is depth(), 2, "$desc: correct depth 4";
  59       return 15, @_;
  60      }, 16, @_, UP);
  61     }->(17, @_);
  62    }, 18, @_, HERE);
  63   }->(19);
  64  };
  65  is $@,      '',                "$desc: no error";
  66  is depth(), 0,                 "$desc: correct depth outside";
  67  is_deeply \@ret, [ 11 .. 19 ], "$desc: correct return value"
  68 }
  69
  70 {
  71  my $desc = 'uplevel in uplevel : higher frame';
  72  local $@;
  73  my @ret = eval {
  74   20, sub {
  75    is depth(), 2, "$desc: correct depth 1";
  76    21, sub {
  77     is depth(), 3, "$desc: correct depth 2";
  78     22, uplevel(sub {
  79      is depth(), 3, "$desc: correct depth 3";
  80      23, sub {
  81       is depth(), 4, "$desc: correct depth 4";
  82       24, uplevel(sub {
  83        is depth(), 2, "$desc: correct depth 5";
  84        return 25, @_;
  85       }, 26, @_, UP UP);
  86      }->(27, @_);
  87     }, 28, @_, HERE);
  88    }->(29, @_);
  89   }->('2A');
  90  };
  91  is $@,      '',                      "$desc: no error";
  92  is depth(), 0,                       "$desc: correct depth outside";
  93  is_deeply \@ret, [ 20 .. 29, '2A' ], "$desc: correct return value"
  94 }