use strict;
use warnings;
-use Test::More tests => (1 * 3 + 2 * 4 + 3 * 5) * 2 + 7 + 5 + 6 + 5;
+use Test::More
+ tests => (1 * 3 + 2 * 4 + 3 * 5) * 2 + 7 + 7 + (5 + 6 + 5 + 6 + 5);
use Scope::Upper qw<uplevel HERE UP TOP>;
like $@, qr/^Can't uplevel to an eval frame/, "$desc: dies";
}
+# XS
+
+{
+ my $desc = 'uplevel to XS 1';
+ local $@;
+ eval {
+ sub {
+ my $cxt = HERE;
+ pass "$desc: before";
+ &uplevel(\&HERE => $cxt);
+ is HERE, $cxt, "$desc: after";
+ }->();
+ };
+ is $@, '', "$desc: no error";
+}
+
+{
+ my $desc = 'uplevel to XS 1';
+ local $@;
+ eval {
+ sub {
+ my $up = HERE;
+ sub {
+ is UP, $up, "$desc: before";
+ &uplevel(\&HERE => $up);
+ isnt HERE, $up, "$desc: after 1";
+ }->();
+ is HERE, $up, "$desc: after 2";
+ }->();
+ };
+ is $@, '', "$desc: no error";
+}
+
# Target destruction
{
is $destroyed, 1, "$desc: target is detroyed";
}
+
+ SKIP: {
+ skip 'This fails even with a plain subroutine call on 5.8.x' => 6
+ if "$]" < 5.009;
+ local $@;
+ local $destroyed = 0;
+ my $desc = 'code destruction';
+
+ {
+ my $lexical;
+ my $code = sub {
+ ++$lexical;
+ is $destroyed, 0, "$desc: not yet 1";
+ };
+ $code = bless $code, 'Scope::Upper::TestCodeDestruction';
+
+ eval {
+ sub {
+ sub {
+ &uplevel($code, UP);
+ is $destroyed, 0, "$desc: not yet 2";
+ }->();
+ is $destroyed, 0, "$desc: not yet 2";
+ }->();
+ };
+ is $@, '', "$desc: no error";
+ is $destroyed, 0, "$desc: not yet 3";
+ };
+
+ is $destroyed, 1, "$desc: code is destroyed";
+ }
+
+ SKIP: {
+ skip 'This fails even with a plain subroutine call on 5.8.x' => 5
+ if "$]" < 5.009;
+ local $@;
+ local $destroyed = 0;
+ my $desc = 'code destruction and goto';
+
+ {
+ my $lexical = 0;
+ my $cb = sub {
+ ++$lexical;
+ is $destroyed, 0, "$desc: not yet 1";
+ };
+ $cb = bless $cb, 'Scope::Upper::TestCodeDestruction';
+
+ eval {
+ sub {
+ &uplevel(sub { goto $cb } => HERE);
+ is $destroyed, 0, "$desc: not yet 2";
+ }->();
+ };
+ is $@, '', "$desc: no error";
+ is $destroyed, 0, "$desc: not yet 3";
+ }
+
+ is $destroyed, 1, "$desc: code is destroyed";
+ }
}