The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -T

use strict;
use warnings;

use Test::More tests => 13 + 3;

use Scope::Upper qw<unwind SCOPE CALLER>;

my ($l1, $l2);

our $x;

sub c {
 $x = 3;
 sub {
  unwind("eval", eval {
   do {
    for (3, 4, 5) {
     1, unwind('from', 'the', 'sub', 'c' => SCOPE $l1);
    }
   }
  } => SCOPE $l2);
 }->(2, 3, 4);
 return 'in c'
}

sub b {
 local $x = 2;
 my @c = (1 .. 12, c());
 is $x, 3, '$x in b after c()';
 return @c, 'in b';
}

sub a {
 local $x = 1;
 my @b = b();
 is $x, 1, '$x in a after b()';
 return @b, 'in a';
}

$l1 = 0;
$l2 = 0;
is_deeply [ a() ], [ 1 .. 12, 'in c', 'in b', 'in a' ],
          'l1=0, l2=0';

$l1 = 0;
$l2 = 1;
is_deeply [ a() ], [ 1 .. 12, qw<eval from the sub c>, 'in b', 'in a' ],
          'l1=0, l2=1';

$l1 = 0;
$l2 = 2;
is_deeply [ a() ], [ qw<eval from the sub c>, 'in a' ],
          'l1=0, l2=2';

$l1 = 4;
$l2 = 999;
is_deeply [ a() ], [ 1 .. 12, qw<from the sub c>, 'in b', 'in a' ],
          'l1=4, l2=?';

$l1 = 5;
$l2 = 999;
is_deeply [ a() ], [ qw<from the sub c>, 'in a' ],
          'l1=5, l2=?';

# Unwinding while unwinding
{
 package Scope::Upper::TestGuard;

 sub new {
  my $class = shift;
  bless { cb => $_[0] }, $class;
 }

 sub DESTROY {
  $_[0]->{cb}->()
 }
}

{
 my $desc = 'unwinding while unwinding';
 local $@;

 eval {
  my @res = sub {
   sub {
    my $guard = Scope::Upper::TestGuard->new(sub {
     my @res = sub {
      sub {
       unwind @_ => CALLER(1);
      }->(@_);
      fail "$desc (second): not reached";
     }->(qw<a b c>);
     is_deeply \@res, [ qw<a b c> ], "$desc (second): correct returned values";
    });
    unwind @_ => CALLER(1);
   }->(@_);
   fail "$desc (first): not reached";
  }->(qw<y z>);
  is_deeply \@res, [ qw<y z> ], "$desc (first): correct returned values";
 };
 is $@, '', "$desc: did not croak";
}