package X;
- use Scope::Upper qw/reap localize localize_elem localize_delete/;
+ use Scope::Upper qw/reap localize localize_elem localize_delete UP/;
sub desc { shift->{desc} }
my ($desc) = @_;
# First localize $x so that it gets destroyed last
- localize '$x' => bless({ desc => $desc }, __PACKAGE__) => 1;
+ localize '$x' => bless({ desc => $desc }, __PACKAGE__) => UP;
reap sub {
my $pkg = caller;
my $x = do { no strict 'refs'; ${$pkg.'::x'} }; # Get the $x in the scope
print $x->desc . ": done\n";
- } => 1;
+ } => UP;
localize_elem '%SIG', '__WARN__' => sub {
my $pkg = caller;
my $x = do { no strict 'refs'; ${$pkg.'::x'} }; # Get the $x in the scope
CORE::warn($x->desc . ': ' . join('', @_));
- } => 1;
+ } => UP;
- localize_delete '@ARGV', $#ARGV => 1; # delete last @ARGV element
+ localize_delete '@ARGV', $#ARGV => UP; # delete last @ARGV element
}
package Y;
Currently, you can hook an upper scope end, or localize variables, array/hash values or deletions of elements in higher contexts.
You can also return to an upper level and know which context was in use then.
+=head1 WORDS
+
+These control words are to be used to indicate the target scope.
+
+=head2 C<TOP>
+
+Returns the level that currently represents the highest scope.
+
+=head2 C<HERE>
+
+The current level.
+
+=head2 C<UP $from>
+
+The level of the scope just above C<$from>.
+
+=head2 C<DOWN $from>
+
+The level of the scope just below C<$from>.
+
+=head2 C<SUB $from>
+
+The level of the closest subroutine context above C<$from>.
+
+=head2 C<EVAL $from>
+
+The level of the closest eval context above C<$from>.
+
+If C<$from> is omitted in any of those functions, the current level is used as the reference level.
+
+=head2 C<CALLER $stack>
+
+The level of the C<$stack>-th upper subroutine/eval/format context.
+It kind of corresponds to the context represented by C<caller $stack>, but while e.g. C<caller 0> refers to the caller context, C<CALLER 0> will refer to the top scope in the current context.
+
=head1 FUNCTIONS
=cut
If the sigil is C<'$'>, L</localize> follows the same syntax as C<local $x = $value>, i.e. C<$value> isn't dereferenced.
For example,
- localize '$x', \'foo' => 0;
+ localize '$x', \'foo' => HERE;
will set C<$x> to a reference to the string C<'foo'>.
Other sigils (C<'@'>, C<'%'>, C<'&'> and C<'*'>) require C<$value> to be a reference of the corresponding type.
When the symbol is given by a string, it is resolved when the actual localization takes place and not when C<localize> is called.
This means that
- sub tag { localize '$x', $_[0] => 1; }
+ sub tag { localize '$x', $_[0] => UP }
will localize in the caller's namespace.
my $num = sub {
my @a = ('a' .. 'z');
- unwind @a => 0;
+ unwind @a => HERE;
}->();
will set C<$num> to C<'z'>.
my $num = sub {
my @a = ('a' .. 'z');
- unwind +(want_at(0) ? @a : scalar @a) => 0;
+ unwind +(want_at(HERE) ? @a : scalar @a) => HERE;
}->();
will righteously set C<$num> to C<26>.
-=head1 WORDS
-
-=head2 C<TOP>
-
-Returns the level that currently represents the highest scope.
-
-=head2 C<HERE>
-
-The current level - i.e. C<0>.
-
-=head2 C<UP $from>
-
-The level of the scope just above C<$from>.
-
-=head2 C<DOWN $from>
-
-The level of the scope just below C<$from>.
-
-=head2 C<SUB $from>
-
-The level of the closest subroutine context above C<$from>.
-
-=head2 C<EVAL $from>
-
-The level of the closest eval context above C<$from>.
-
-If C<$from> is omitted in any of those functions, the current level is used as the reference level.
-
-=head2 C<CALLER $stack>
-
-The level of the C<$stack>-th upper subroutine/eval/format context.
-It kind of corresponds to the context represented by C<caller $stack>, but while e.g. C<caller 0> refers to the caller context, C<CALLER 0> will refer to the top scope in the current context.
-For example,
-
- reap ... => CALLER(0)
-
-will fire the destructor when the current subroutine/eval/format ends.
-
=head1 EXPORT
The functions L</reap>, L</localize>, L</localize_elem>, L</localize_delete>, L</unwind> and L</want_at> are only exported on request, either individually or by the tags C<':funcs'> and C<':all'>.
local $x = 0;
{
- reap sub { print $x } => 0;
+ reap sub { print $x } => HERE;
local $x = 1;
...
}
...
{
local $x = 1;
- reap sub { $x = 2 } => 0;
+ reap sub { $x = 2 } => HERE;
...
}
# $x is 0
use blib;
-use Scope::Upper qw/reap localize localize_elem localize_delete/;
+use Scope::Upper qw/reap localize localize_elem localize_delete UP/;
sub desc { shift->{desc} }
my ($desc) = @_;
# First localize $x so that it gets destroyed last
- localize '$x' => bless({ desc => $desc }, __PACKAGE__) => 1;
+ localize '$x' => bless({ desc => $desc }, __PACKAGE__) => UP;
reap sub {
my $pkg = caller;
my $x = do { no strict 'refs'; ${$pkg.'::x'} }; # Get the $x in the scope
print $x->desc . ": done\n";
- } => 1;
+ } => UP;
localize_elem '%SIG', '__WARN__' => sub {
my $pkg = caller;
my $x = do { no strict 'refs'; ${$pkg.'::x'} }; # Get the $x in the scope
CORE::warn($x->desc . ': ' . join('', @_));
- } => 1;
+ } => UP;
- localize_delete '@ARGV', $#ARGV => 1; # delete last @ARGV element
+ localize_delete '@ARGV', $#ARGV => UP; # delete last @ARGV element
}
package main;
use Test::More tests => 19;
-use Scope::Upper qw/want_at/;
+use Scope::Upper qw/want_at UP HERE/;
sub check {
my ($w, $exp, $desc) = @_;
my $w;
-check want_at, undef, 'main : want_at';
-check want_at(0), undef, 'main : want_at(0)';
-check want_at(1), undef, 'main : want_at(1)';
-check want_at(-1), undef, 'main : want_at(-1)';
+check want_at, undef, 'main : want_at';
+check want_at(HERE), undef, 'main : want_at HERE';
+check want_at(UP), undef, 'main : want_at UP';
+check want_at(-1), undef, 'main : want_at -1';
my @a = sub {
check want_at, 1, 'sub0 : want_at';
{
- check want_at, 1, 'sub : want_at';
- check want_at(1), 1, 'sub : want_at(1)';
+ check want_at, 1, 'sub : want_at';
+ check want_at(UP), 1, 'sub : want_at UP';
for (1) {
- check want_at, 1, 'for : want_at';
- check want_at(1), 1, 'for : want_at(1)';
- check want_at(2), 1, 'for : want_at(2)';
+ check want_at, 1, 'for : want_at';
+ check want_at(UP), 1, 'for : want_at UP';
+ check want_at(UP UP), 1, 'for : want_at UP UP';
}
eval "
- check want_at, undef, 'eval string : want_at';
- check want_at(1), 1, 'eval string : want_at(1)';
- check want_at(2), 1, 'eval string : want_at(2)';
+ check want_at, undef, 'eval string : want_at';
+ check want_at(UP), 1, 'eval string : want_at UP';
+ check want_at(UP UP), 1, 'eval string : want_at UP UP';
";
my $x = eval {
do {
- check want_at, 0, 'do : want_at';
- check want_at(1), 0, 'do : want_at(0)';
- check want_at(2), 1, 'do : want_at(1)';
+ check want_at, 0, 'do : want_at';
+ check want_at(UP), 0, 'do : want_at UP';
+ check want_at(UP UP), 1, 'do : want_at UP UP';
};
- check want_at, 0, 'eval : want_at';
- check want_at(1), 1, 'eval : want_at(0)';
- check want_at(2), 1, 'eval : want_at(1)';
+ check want_at, 0, 'eval : want_at';
+ check want_at(UP), 1, 'eval : want_at UP';
+ check want_at(UP UP), 1, 'eval : want_at UP UP';
};
}
}->();
use Test::More 'no_plan';
-use Scope::Upper qw/reap/;
+use Scope::Upper qw/reap UP HERE/;
use lib 't/lib';
use Scope::Upper::TestGenerator;
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "reap \\&check => $level;\n" ];
};
use Test::More 'no_plan';
-use Scope::Upper qw/reap/;
+use Scope::Upper qw/reap UP HERE/;
use lib 't/lib';
use Scope::Upper::TestGenerator;
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "reap \\&check => $level;\n" ];
};
use Test::More tests => 38;
-use Scope::Upper qw/reap/;
+use Scope::Upper qw/reap UP HERE/;
our ($x, $y);
{
local $x = 2;
{
- reap \&check => 1;
+ reap \&check => UP;
}
is $x, 2, 'goto 1 [not yet - x]';
is $y, undef, 'goto 1 [not yet - y]';
{
local $x = 3;
{
- reap \&check => 2;
+ reap \&check => UP UP;
}
is $x, 3, 'goto 2 [not yet - x]';
is $y, undef, 'goto 2 [not yet - y]';
{
{
local $x = 3;
- reap \&check => 3;
+ reap \&check => UP UP UP;
is $x, 3, 'die - reap outside eval [not yet 1 - x]';
is $y, undef, 'die - reap outside eval [not yet 1 - y]';
}
{
{
local $x = 3;
- reap \&check => 2;
+ reap \&check => UP UP;
is $x, 3, 'die - reap at eval [not yet 1 - x]';
is $y, undef, 'die - reap at eval [not yet 1 - y]';
}
{
{
local $x = 3;
- reap \&check => 1;
+ reap \&check => UP;
is $x, 3, 'die - reap inside eval [not yet 1 - x]';
is $y, undef, 'die - reap inside eval [not yet 1 - y]';
}
local $x = 2;
eval {
local $x = 3;
- reap { ++$y; die "reaped\n" } => 0;
+ reap { ++$y; die "reaped\n" } => HERE;
is $x, 3, 'die in reap at eval [not yet - x]';
is $y, undef, 'die in reap at eval [not yet - y]';
}; # should trigger here, but the die isn't catched by this eval
local $x = 2;
{
local $x = 3;
- reap { ++$y; die "reaped\n" } => 0;
+ reap { ++$y; die "reaped\n" } => HERE;
is $x, 3, 'die in reap inside eval [not yet - x]';
is $y, undef, 'die in reap inside eval [not yet - y]';
} # should trigger here
use Test::More tests => 8 + 18 + 4 + 8 + 11 + 5 + 17;
-use Scope::Upper qw/reap/;
+use Scope::Upper qw/reap UP HERE/;
my $x;
-sub add { local $_; my $y = $_[1]; reap sub { $x += $y }, $_[0] + 1 }
+sub add { local $_; my $y = $_[0]; reap sub { $x += $y } => $_[1] }
$x = 0;
{
is($x, 0, 'start');
{
- add(0, 1);
+ add 1 => HERE;
is($x, 0, '1 didn\'t run');
{
- add(0, 2);
+ add 2 => HERE;
is($x, 0, '1 and 2 didn\'t run');
}
is($x, 2, '1 didn\'t run, 2 ran');
{
- add(0, 4);
+ add 4 => HERE;
is($x, 2, '1 and 3 didn\'t run, 2 ran');
}
is($x, 6, '1 didn\'t run, 2 and 3 ran');
local $_ = 3;
is($_, 3, '$_ has the right value');
{
- add(0, 1);
+ add 1 => HERE;
is($_, 3, '$_ has the right value');
local $_ = 5;
is($x, 0, '1 didn\'t run');
is($_, 5, '$_ has the right value');
{
- add(0, 2);
+ add 2 => HERE;
is($_, 5, '$_ has the right value');
local $_ = 7;
is($_, 7, '$_ has the right value');
{
local $_ = 9;
is($_, 9, '$_ has the right value');
- add(0, 4);
+ add 4 => HERE;
local $_ = 11;
is($_, 11, '$_ has the right value');
is($x, 2, '1 and 3 didn\'t run, 2 ran');
{
is($x, 0, 'start');
{
- add(0, 1);
- add(0, 2);
+ add 1 => HERE;
+ add 2 => HERE;
is($x, 0, '1 and 2 didn\'t run');
}
is($x, 3, '1 and 2 ran');
local $_ = 3;
{
local $_ = 5;
- add(0, 1);
+ add 1 => HERE;
is($_, 5, '$_ has the right value');
local $_ = 7;
- add(0, 2);
+ add 2 => HERE;
is($_, 7, '$_ has the right value');
is($x, 0, '1 and 2 didn\'t run');
local $_ = 9;
is($x, 0, 'start');
{
{
- add(1, 1);
+ add 1 => UP;
is($x, 0, '1 didn\'t run');
}
is($x, 0, '1 didn\'t run');
{
{
{
- add(2, 2);
+ add 2 => UP UP;
is($x, 1, '2 didn\'t run');
}
is($x, 1, '2 didn\'t run');
{
- add(1, 4);
+ add 4 => UP;
is($x, 1, '2 and 3 didn\'t run');
}
is($x, 1, '2 and 3 didn\'t run');
}
is($x, 7, 'end');
-sub bleh { add(1, 2); }
+sub bleh { add 2 => UP; }
$x = 0;
{
is($x, 0, 'start');
{
- add(0, 1);
+ add 1 => HERE;
is($x, 0, '1 didn\'t run');
bleh();
is($x, 0, '1 didn\'t run');
sub bar {
is($_, 7, '$_ has the right value');
local $_ = 9;
- add(2, 4);
+ add 4 => UP UP;
is($_, 9, '$_ has the right value');
- add(3, 8);
+ add 8 => UP UP UP;
is($_, 9, '$_ has the right value');
}
sub foo {
local $_ = 7;
- add(0, 2);
+ add 2 => HERE;
is($_, 7, '$_ has the right value');
is($x, 0, '1, 2 didn\'t run');
bar();
is($x, 0, '1, 2, 3, 4 didn\'t run');
is($_, 7, '$_ has the right value');
- add(1, 16);
+ add 16 => UP;
is($_, 7, '$_ has the right value');
}
{
is($x, 0, 'start');
local $_ = 3;
- add(0, 1);
+ add 1 => HERE;
is($_, 3, '$_ has the right value');
{
local $_ = 5;
use Test::More tests => 50;
-use Scope::Upper qw/localize/;
+use Scope::Upper qw/localize UP HERE/;
# Scalars
{
local $x = 2;
{
- localize *x, \1, 0;
- is $x, 1, 'localize *x, \1, 0 [ok]';
+ localize *x, \1 => HERE;
+ is $x, 1, 'localize *x, \1 => HERE [ok]';
}
- is $x, 2, 'localize *x, \1, 0 [end]';
+ is $x, 2, 'localize *x, \1 => HERE [end]';
}
sub _t { shift->{t} }
{
local $x;
{
- localize *x, \bless({ t => 1 }, 'main'), 0;
- is ref($x), 'main', 'localize *x, obj, 0 [ref]';
- is $x->_t, 1, 'localize *x, obj, 0 [meth]';
+ localize *x, \bless({ t => 1 }, 'main') => HERE;
+ is ref($x), 'main', 'localize *x, obj => HERE [ref]';
+ is $x->_t, 1, 'localize *x, obj => HERE [meth]';
}
- is $x, undef, 'localize *x, obj, 0 [end]';
+ is $x, undef, 'localize *x, obj => HERE [end]';
}
{
local $x = 2;
{
local $x = 3;
- localize *x, 1, 0;
- is $x, undef, 'localize *x, 1, 0 [ok]';
+ localize *x, 1 => HERE;
+ is $x, undef, 'localize *x, 1 => HERE [ok]';
}
- is $x, $] < 5.008009 ? undef : 2, 'localize *x, 1, 0 [end]';
+ is $x, $] < 5.008009 ? undef : 2, 'localize *x, 1 => HERE [end]';
}
undef *x;
{
local $x = 7;
{
- localize '$x', 2, 0;
- is $x, 2, 'localize "$x", 2, 0 [ok]';
+ localize '$x', 2 => HERE;
+ is $x, 2, 'localize "$x", 2 => HERE [ok]';
}
- is $x, 7, 'localize "$x", 2, 0 [end]';
+ is $x, 7, 'localize "$x", 2 => HERE [end]';
}
{
local $x = 8;
{
- localize ' $x', 3, 0;
- is $x, 3, 'localize " $x", 3, 0 [ok]';
+ localize ' $x', 3 => HERE;
+ is $x, 3, 'localize " $x", 3 => HERE [ok]';
}
- is $x, 8, 'localize " $x", 3, 0 [end]';
+ is $x, 8, 'localize " $x", 3 => HERE [end]';
}
SKIP:
no strict 'refs';
local ${''} = 9;
{
- localize '$', 4, 0;
- is ${''}, 4, 'localize "$", 4, 0 [ok]';
+ localize '$', 4 => HERE;
+ is ${''}, 4, 'localize "$", 4 => HERE [ok]';
}
- is ${''}, 9, 'localize "$", 4, 0 [end]';
+ is ${''}, 9, 'localize "$", 4 => HERE [end]';
};
}
no strict 'refs';
local ${''} = 10;
{
- localize '', 5, 0;
- is ${''}, 5, 'localize "", 4, 0 [ok]';
+ localize '', 5 => HERE;
+ is ${''}, 5, 'localize "", 4 => HERE [ok]';
}
- is ${''}, 10, 'localize "", 4, 0 [end]';
+ is ${''}, 10, 'localize "", 4 => HERE [end]';
};
}
{
local $x = 2;
{
- localize 'x', \1, 0;
- is $x, 1, 'localize "x", \1, 0 [ok]';
+ localize 'x', \1 => HERE;
+ is $x, 1, 'localize "x", \1 => HERE [ok]';
}
- is $x, 2, 'localize "x", \1, 0 [end]';
+ is $x, 2, 'localize "x", \1 => HERE [end]';
}
{
local $x = 4;
{
- localize 'x', 3, 0;
- is $x, 3, 'localize "x", 3, 0 [ok]';
+ localize 'x', 3 => HERE;
+ is $x, 3, 'localize "x", 3 => HERE [ok]';
}
- is $x, 4, 'localize "x", 3, 0 [end]';
+ is $x, 4, 'localize "x", 3 => HERE [end]';
}
{
local $x;
{
- localize 'x', bless({ t => 2 }, 'main'), 0;
- is ref($x), 'main', 'localize "x", obj, 0 [ref]';
- is $x->_t, 2, 'localize "x", obj, 0 [meth]';
+ localize 'x', bless({ t => 2 }, 'main') => HERE;
+ is ref($x), 'main', 'localize "x", obj => HERE [ref]';
+ is $x->_t, 2, 'localize "x", obj => HERE [meth]';
}
- is $x, undef, 'localize "x", obj, 0 [end]';
+ is $x, undef, 'localize "x", obj => HERE [end]';
}
sub callthrough (*$) {
$val = eval "\\$val";
}
local $x = 'x';
- localize $what, $val, 1;
+ localize $what, $val => UP;
is $x, 'x', 'localize callthrough [not yet]';
}
{
local @a = (4 .. 6);
{
- localize *a, $xa, 0;
- is_deeply \@a, $xa, 'localize *a, [ ], 0 [ok]';
+ localize *a, $xa => HERE;
+ is_deeply \@a, $xa, 'localize *a, [ ] => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize *a, [ ], 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize *a, [ ] => HERE [end]';
}
{
{
local @a = (5 .. 7);
{
- localize *a, $xa, 1;
- is_deeply \@a, [ 5 .. 7 ], 'localize *a, [ ], 1 [not yet]';
+ localize *a, $xa => UP;
+ is_deeply \@a, [ 5 .. 7 ], 'localize *a, [ ] => UP [not yet]';
}
- is_deeply \@a, $xa, 'localize *a, [ ], 1 [ok]';
+ is_deeply \@a, $xa, 'localize *a, [ ] => UP [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize *a, [ ], 1 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize *a, [ ] => UP [end]';
}
# Hashes
{
local %h = (a => 1, b => 2);
{
- localize *h, $xh, 0;
- is_deeply \%h, $xh, 'localize *h, { }, 0 [ok]';
+ localize *h, $xh => HERE;
+ is_deeply \%h, $xh, 'localize *h, { } => HERE [ok]';
}
- is_deeply \%h, { a => 1, b => 2 }, 'localize *h, { }, 0 [end]';
+ is_deeply \%h, { a => 1, b => 2 }, 'localize *h, { } => HERE [end]';
}
{
{
local %h = (b => 3, c => 4);
{
- localize *h, $xh, 1;
- is_deeply \%h, { b => 3, c => 4 }, 'localize *h, { }, 1 [not yet]';
+ localize *h, $xh => UP;
+ is_deeply \%h, { b => 3, c => 4 }, 'localize *h, { } => UP [not yet]';
}
- is_deeply \%h, $xh, 'localize *h, { }, 1 [ok]';
+ is_deeply \%h, $xh, 'localize *h, { } => UP [ok]';
}
- is_deeply \%h, { a => 1, b => 2 }, 'localize *h, { }, 1 [end]';
+ is_deeply \%h, { a => 1, b => 2 }, 'localize *h, { } => UP [end]';
}
# Code
{
local *foo = sub { 7 };
{
- localize *foo, sub { 6 }, 1;
- is foo(), 7, 'localize *foo, sub { 6 }, 1 [not yet]';
+ localize *foo, sub { 6 } => UP;
+ is foo(), 7, 'localize *foo, sub { 6 } => UP [not yet]';
}
- is foo(), 6, 'localize *foo, sub { 6 }, 1 [ok]';
+ is foo(), 6, 'localize *foo, sub { 6 } => UP [ok]';
}
{
local *foo = sub { 9 };
{
- localize '&foo', sub { 8 }, 1;
- is foo(), 9, 'localize "&foo", sub { 8 }, 1 [not yet]';
+ localize '&foo', sub { 8 } => UP;
+ is foo(), 9, 'localize "&foo", sub { 8 } => UP [not yet]';
}
- is foo(), 8, 'localize "&foo", sub { 8 }, 1 [ok]';
+ is foo(), 8, 'localize "&foo", sub { 8 } => UP [ok]';
}
use Test::More 'no_plan';
-use Scope::Upper qw/localize/;
+use Scope::Upper qw/localize UP HERE/;
use lib 't/lib';
use Scope::Upper::TestGenerator;
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "localize '\$main::y' => 1 => $level;\n" ];
};
use Test::More 'no_plan';
-use Scope::Upper qw/localize/;
+use Scope::Upper qw/localize UP HERE/;
use lib 't/lib';
use Scope::Upper::TestGenerator;
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "localize '\$x' => 0 => $level;\n" ];
};
use Test::More tests => 44;
-use Scope::Upper qw/localize/;
+use Scope::Upper qw/localize UP HERE/;
our ($x, $y);
local $x = 1;
{
local $x = 2;
- localize '$y' => 1 => 0;
+ localize '$y' => 1 => HERE;
is $x, 2, 'last 0 [ok - x]';
is $y, 1, 'last 0 [ok - y]';
last;
local $y = 0;
{
local $x = 3;
- localize '$y' => 1 => 1;
+ localize '$y' => 1 => UP;
is $x, 3, 'last 1 [ok - x]';
is $y, 0, 'last 1 [ok - y]';
last LOOP;
local $x = 1;
{
local $x = 2;
- localize '$y' => 1 => 0;
+ localize '$y' => 1 => HERE;
is $x, 2, 'next 0 [ok - x]';
is $y, 1, 'next 0 [ok - y]';
next;
local $y = 0;
{
local $x = 3;
- localize '$y' => 1 => 1;
+ localize '$y' => 1 => UP;
is $x, 3, 'next 1 [ok - x]';
is $y, 0, 'next 1 [ok - y]';
next LOOP;
{
local $x = 2;
{
- localize '$y' => 1 => 2;
+ localize '$y' => 1 => UP UP;
}
is $x, 2, 'goto 1 [not yet - x]';
is $y, undef, 'goto 1 [not yet - y]';
{
local $x = 3;
{
- localize '$y' => 1 => 3;
+ localize '$y' => 1 => UP UP UP;
}
is $x, 3, 'goto 2 [not yet - x]';
is $y, undef, 'goto 2 [not yet - y]';
{
{
local $x = 3;
- localize '$y' => 1 => 4;
+ localize '$y' => 1 => UP UP UP UP;
is $x, 3, 'die - reap outside eval [not yet 1 - x]';
is $y, undef, 'die - reap outside eval [not yet 1 - y]';
}
{
{
local $x = 3;
- localize '$y' => 1 => 3;
+ localize '$y' => 1 => UP UP UP;
is $x, 3, 'die - reap at eval [not yet 1 - x]';
is $y, undef, 'die - reap at eval [not yet 1 - y]';
}
{
{
local $x = 3;
- localize '$y' => 1 => 2;
+ localize '$y' => 1 => UP UP;
is $x, 3, 'die - reap inside eval [not yet 1 - x]';
is $y, undef, 'die - reap inside eval [not yet 1 - y]';
}
use Test::More tests => 10 + 5 + 6;
-use Scope::Upper qw/localize/;
+use Scope::Upper qw/localize UP HERE/;
our $x;
-sub loc { local $x; my $y = $_[1]; localize '$x', $y, $_[0] + 1 }
+sub loc { local $x; my $y = $_[0]; localize '$x', $y => $_[1] }
$x = 0;
{
local $x = 7;
{
local $x = 8;
- loc(1, 1);
+ loc 1 => UP;
is($x, 8, 'not localized');
local $x = 9;
is($x, 9, 'not localized');
{
{
local $x = 8;
- loc(2, 1);
+ loc 1 => UP UP;
is($x, 8, 'not localized');
}
- loc(0, 2);
+ loc 2 => HERE;
is($x, 2, 'localized to 2');
}
is($x, 1, 'localized to 1');
local $x;
{
{
- loc(2, 1);
+ loc 1 => UP UP;
is($x, undef, 'not localized');
local $x;
- loc(1, 2);
+ loc 2 => UP;
is($x, undef, 'not localized');
}
is($x, 2, 'localized to 2');
use Test::More tests => 21;
-use Scope::Upper qw/localize_elem/;
+use Scope::Upper qw/localize_elem UP HERE/;
# Arrays
{
local @a = (4 .. 6);
{
- localize_elem '@main::a', 1, 8, 0;
- is_deeply \@a, [ 4, 8, 6 ], 'localize_elem "@a", 1, 8, 0 [ok]';
+ localize_elem '@main::a', 1, 8 => HERE;
+ is_deeply \@a, [ 4, 8, 6 ], 'localize_elem "@a", 1, 8 => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 1, 8, 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 1, 8 => HERE [end]';
}
{
local @a = (4 .. 6);
{
- localize_elem '@main::a', 4, 8, 0;
- is_deeply \@a, [ 4 .. 6, undef, 8 ], 'localize_elem "@a", 4, 8, 0 [ok]';
+ localize_elem '@main::a', 4, 8 => HERE;
+ is_deeply \@a, [ 4 .. 6, undef, 8 ], 'localize_elem "@a", 4, 8 => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 4, 8, 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 4, 8 => HERE [end]';
}
{
local @a = (4 .. 6);
{
- localize_elem '@main::a', -2, 8, 0;
- is_deeply \@a, [ 4, 8, 6 ], 'localize_elem "@a", -2, 8, 0 [ok]';
+ localize_elem '@main::a', -2, 8 => HERE;
+ is_deeply \@a, [ 4, 8, 6 ], 'localize_elem "@a", -2, 8 => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", -2, 8, 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", -2, 8 => HERE [end]';
}
{
local @a = (4 .. 6);
{
- eval { localize_elem '@main::a', -4, 8, 0 };
- like $@, qr/Modification of non-creatable array value attempted, subscript -4/, 'localize_elem "@a", -4, 8, 0 [ok]';
+ eval { localize_elem '@main::a', -4, 8 => HERE };
+ like $@, qr/Modification of non-creatable array value attempted, subscript -4/, 'localize_elem "@a", -4, 8 => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", -4, 8, 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", -4, 8 => HERE [end]';
}
{
{
local @a = (5 .. 7);
{
- localize_elem '@main::a', 1, 12, 1;
- is_deeply \@a, [ 5 .. 7 ], 'localize_elem "@a", 1, 12, 1 [not yet]';
+ localize_elem '@main::a', 1, 12 => UP;
+ is_deeply \@a, [ 5 .. 7 ], 'localize_elem "@a", 1, 12 => UP [not yet]';
}
- is_deeply \@a, [ 5, 12, 7 ], 'localize_elem "@a", 1, 12, 1 [ok]';
+ is_deeply \@a, [ 5, 12, 7 ], 'localize_elem "@a", 1, 12 => UP [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 1, 12, 1 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 1, 12 => UP [end]';
}
{
{
local @a = (5 .. 7);
{
- localize_elem '@main::a', 4, 12, 1;
- is_deeply \@a, [ 5 .. 7 ], 'localize_elem "@a", 4, 12, 1 [not yet]';
+ localize_elem '@main::a', 4, 12 => UP;
+ is_deeply \@a, [ 5 .. 7 ], 'localize_elem "@a", 4, 12 => UP [not yet]';
}
- is_deeply \@a, [ 5 .. 7, undef, 12 ], 'localize_elem "@a", 4, 12, 1 [ok]';
+ is_deeply \@a, [ 5 .. 7, undef, 12 ], 'localize_elem "@a", 4, 12 => UP [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 4, 12, 1 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 4, 12 => UP [end]';
}
# Hashes
{
local %h = (a => 1, b => 2);
{
- localize_elem '%main::h', 'a', 3, 0;
- is_deeply \%h, { a => 3, b => 2 }, 'localize_elem "%h", "a", 3, 0 [ok]';
+ localize_elem '%main::h', 'a', 3 => HERE;
+ is_deeply \%h, { a => 3, b => 2 }, 'localize_elem "%h", "a", 3 => HERE [ok]';
}
- is_deeply \%h, { a => 1, b => 2 }, 'localize_elem "%h", "a", 3, 0 [end]';
+ is_deeply \%h, { a => 1, b => 2 }, 'localize_elem "%h", "a", 3 => HERE [end]';
}
{
local %h = (a => 1, b => 2);
{
- localize_elem '%main::h', 'c', 3, 0;
- is_deeply \%h, { a => 1, b => 2, c => 3 }, 'localize_elem "%h", "c", 3, 0 [ok]';
+ localize_elem '%main::h', 'c', 3 => HERE;
+ is_deeply \%h, { a => 1, b => 2, c => 3 }, 'localize_elem "%h", "c", 3 => HERE [ok]';
}
- is_deeply \%h, { a => 1, b => 2 }, 'localize_elem "%h", "c", 3, 0 [end]';
+ is_deeply \%h, { a => 1, b => 2 }, 'localize_elem "%h", "c", 3 => HERE [end]';
}
{
{
local %h = (a => 3, c => 4);
{
- localize_elem '%main::h', 'a', 5, 1;
- is_deeply \%h, { a => 3, c => 4 }, 'localize_elem "%h", "a", 5, 1 [not yet]';
+ localize_elem '%main::h', 'a', 5 => UP;
+ is_deeply \%h, { a => 3, c => 4 }, 'localize_elem "%h", "a", 5 => UP [not yet]';
}
- is_deeply \%h, { a => 5, c => 4 }, 'localize_elem "%h", "a", 5, 1 [ok]';
+ is_deeply \%h, { a => 5, c => 4 }, 'localize_elem "%h", "a", 5 => UP [ok]';
}
- is_deeply \%h, { a => 1, b => 2 }, 'localize_elem "%h", "a", 5, 1 [end]';
+ is_deeply \%h, { a => 1, b => 2 }, 'localize_elem "%h", "a", 5 => UP [end]';
}
use Test::More 'no_plan';
-use Scope::Upper qw/localize_elem/;
+use Scope::Upper qw/localize_elem UP HERE/;
use lib 't/lib';
use Scope::Upper::TestGenerator;
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "localize_elem '\@main::a', 1 => 3 => $level;\n" ];
};
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "localize_elem '%main::h', 'a' => 1 => $level;\n" ];
};
use Test::More 'no_plan';
-use Scope::Upper qw/localize_elem/;
+use Scope::Upper qw/localize_elem UP HERE/;
use lib 't/lib';
use Scope::Upper::TestGenerator;
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "localize_elem '\@a', 1 => 0 => $level;\n" ];
};
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "localize_elem '%h', 'a' => 0 => $level;\n" ];
};
use strict;
use warnings;
-use Scope::Upper qw/localize_elem/;
+use Scope::Upper qw/localize_elem UP HERE/;
use Test::More tests => 8;
{
local @a = (5 .. 7);
{
- localize_elem '@a', 4 => 12 => 0;
- is_deeply \@a, [ 5 .. 7, undef, 12 ], 'localize_elem @incomplete_tied_array, $nonexistent, 12 => 0 [ok]';
+ localize_elem '@a', 4 => 12 => HERE;
+ is_deeply \@a, [ 5 .. 7, undef, 12 ], 'localize_elem @incomplete_tied_array, $nonexistent, 12 => HERE [ok]';
}
- is_deeply \@a, [ 5 .. 7, undef, undef ], 'localize_elem @incomplete_tied_array, $nonexistent, 12 => 0 [end]';
+ is_deeply \@a, [ 5 .. 7, undef, undef ], 'localize_elem @incomplete_tied_array, $nonexistent, 12 => HERE [end]';
}
our $x;
local $SIG{__WARN__} = sub { };
{
{
- localize_elem '%SIG', '__WARN__' => sub { $x = join '', @_ }, 1;
+ localize_elem '%SIG', '__WARN__' => sub { $x = join '', @_ } => UP;
is $x, undef, 'localize_elem $SIG{__WARN__} [not yet]';
}
warn "1\n";
local $ENV{SCOPE_UPPER_TEST};
{
{
- localize_elem '%ENV', 'SCOPE_UPPER_TEST' => $time, 1;
+ localize_elem '%ENV', 'SCOPE_UPPER_TEST' => $time => UP;
runperl $time, 0, 'localize_elem $ENV{SCOPE_UPPER_TEST} [not yet]';
}
runperl $time, 1, 'localize_elem $ENV{SCOPE_UPPER_TEST} [ok]';
use Test::More tests => 36;
-use Scope::Upper qw/localize_delete/;
+use Scope::Upper qw/localize_delete UP HERE/;
# Arrays
{
local @a = (4 .. 6);
{
- localize_delete '@main::a', 1, 0;
- is_deeply \@a, [ 4, undef, 6 ], 'localize_delete "@a", 1, 0 [ok]';
+ localize_delete '@main::a', 1 => HERE;
+ is_deeply \@a, [ 4, undef, 6 ], 'localize_delete "@a", 1 => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 1, 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 1 => HERE [end]';
}
{
local @a = (4 .. 6);
{
- localize_delete '@main::a', 4, 0;
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent), 0 [ok]';
+ localize_delete '@main::a', 4 => HERE;
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent) => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent), 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent) => HERE [end]';
}
{
local @a = (4 .. 6);
local $a[4] = 7;
{
- localize_delete '@main::a', 4, 0;
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (exists), 0 [ok]';
+ localize_delete '@main::a', 4 => HERE;
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (exists) => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6, undef, 7 ], 'localize_delete "@a", 4 (exists), 0 [end]';
+ is_deeply \@a, [ 4 .. 6, undef, 7 ], 'localize_delete "@a", 4 (exists) => HERE [end]';
}
{
local @a = (4 .. 6);
{
- localize_delete '@main::a', -2, 0;
- is_deeply \@a, [ 4, undef, 6 ], 'localize_delete "@a", -2, 0 [ok]';
+ localize_delete '@main::a', -2 => HERE;
+ is_deeply \@a, [ 4, undef, 6 ], 'localize_delete "@a", -2 => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -2, 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -2 => HERE [end]';
}
{
local @a = (4 .. 6);
local $a[4] = 7;
{
- localize_delete '@main::a', -1, 0;
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -1 (exists), 0 [ok]';
+ localize_delete '@main::a', -1 => HERE;
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -1 (exists) => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6, undef, 7 ], 'localize_delete "@a", -1 (exists), 0 [end]';
+ is_deeply \@a, [ 4 .. 6, undef, 7 ], 'localize_delete "@a", -1 (exists) => HERE [end]';
}
{
local @a = (4 .. 6);
{
- eval { localize_delete '@main::a', -4, 0 };
- like $@, qr/Modification of non-creatable array value attempted, subscript -4/, 'localize_delete "@a", -4 (out of bounds), 0 [ok]';
+ eval { localize_delete '@main::a', -4 => HERE };
+ like $@, qr/Modification of non-creatable array value attempted, subscript -4/, 'localize_delete "@a", -4 (out of bounds) => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -4 (out of bounds), 0 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -4 (out of bounds) => HERE [end]';
}
{
{
local @a = (5 .. 7);
{
- localize_delete '@main::a', 1, 1;
- is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 1, 1 [not yet]';
+ localize_delete '@main::a', 1 => UP;
+ is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 1 => UP [not yet]';
}
- is_deeply \@a, [ 5, undef, 7 ], 'localize_delete "@a", 1, 1 [ok]';
+ is_deeply \@a, [ 5, undef, 7 ], 'localize_delete "@a", 1 => UP [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 1, 1 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 1 => UP [end]';
}
{
{
local @a = (5 .. 7);
{
- localize_delete '@main::a', 4, 1;
- is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (nonexistent), 1 [not yet]';
+ localize_delete '@main::a', 4 => UP;
+ is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (nonexistent) => UP [not yet]';
}
- is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (nonexistent), 1 [ok]';
+ is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (nonexistent) => UP [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent), 1 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent) => UP [end]';
}
{
local @a = (5 .. 7);
local $a[4] = 8;
{
- localize_delete '@main::a', 4, 1;
- is_deeply \@a, [ 5 .. 7, undef, 8 ], 'localize_delete "@a", 4 (exists), 1 [not yet]';
+ localize_delete '@main::a', 4 => UP;
+ is_deeply \@a, [ 5 .. 7, undef, 8 ], 'localize_delete "@a", 4 (exists) => UP [not yet]';
}
- is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (exists), 1 [ok]';
+ is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (exists) => UP [ok]';
}
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (exists), 1 [end]';
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (exists) => UP [end]';
}
# Hashes
{
local %h = (a => 1, b => 2);
{
- localize_delete '%main::h', 'a', 0;
- is_deeply \%h, { b => 2 }, 'localize_delete "%h", "a", 0 [ok]';
+ localize_delete '%main::h', 'a' => HERE;
+ is_deeply \%h, { b => 2 }, 'localize_delete "%h", "a" => HERE [ok]';
}
- is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "a", 0 [end]';
+ is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "a" => HERE [end]';
}
{
local %h = (a => 1, b => 2);
{
- localize_delete '%main::h', 'c', 0;
- is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "c", 0 [ok]';
+ localize_delete '%main::h', 'c' => HERE;
+ is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "c" => HERE [ok]';
}
- is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "c", 0 [end]';
+ is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "c" => HERE [end]';
}
{
{
local %h = (a => 3, c => 4);
{
- localize_delete '%main::h', 'a', 1;
- is_deeply \%h, { a => 3, c => 4 }, 'localize_delete "%h", "a", 1 [not yet]';
+ localize_delete '%main::h', 'a' => UP;
+ is_deeply \%h, { a => 3, c => 4 }, 'localize_delete "%h", "a" => UP [not yet]';
}
- is_deeply \%h, { c => 4 }, 'localize_delete "%h", "a", 1 [ok]';
+ is_deeply \%h, { c => 4 }, 'localize_delete "%h", "a" => UP [ok]';
}
- is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "a", 1 [end]';
+ is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "a" => UP [end]';
}
# Others
our $x = 1;
{
- localize_delete '$x', 2, 0;
- is $x, undef, 'localize "$x", anything, 0 [ok]';
+ localize_delete '$x', 2 => HERE;
+ is $x, undef, 'localize "$x", anything => HERE [ok]';
}
-is $x, 1, 'localize "$x", anything, 0 [end]';
+is $x, 1, 'localize "$x", anything => HERE [end]';
sub x { 1 };
{
- localize_delete '&x', 2, 0;
- ok !exists(&x), 'localize "&x", anything, 0 [ok]';
+ localize_delete '&x', 2 => HERE;
+ ok !exists(&x), 'localize "&x", anything => HERE [ok]';
}
-is x(), 1, 'localize "&x", anything, 0 [end]';
+is x(), 1, 'localize "&x", anything => HERE [end]';
{
- localize_delete *x, sub { }, 0;
- is !exists(&x), 1, 'localize *x, anything, 0 [ok 1]';
- is !defined($x), 1, 'localize *x, anything, 0 [ok 2]';
+ localize_delete *x, sub { } => HERE;
+ is !exists(&x), 1, 'localize *x, anything => HERE [ok 1]';
+ is !defined($x), 1, 'localize *x, anything => HERE [ok 2]';
}
-is x(), 1, 'localize *x, anything, 0 [end 1]';
-is $x, 1, 'localize *x, anything, 0 [end 2]';
+is x(), 1, 'localize *x, anything => HERE [end 1]';
+is $x, 1, 'localize *x, anything => HERE [end 2]';
use Test::More 'no_plan';
-use Scope::Upper qw/localize_delete/;
+use Scope::Upper qw/localize_delete UP HERE/;
use lib 't/lib';
use Scope::Upper::TestGenerator;
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "localize_delete '\@main::a', 2 => $level;\n" ];
};
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "localize_delete '%main::h', 'a' => $level;\n" ];
};
use strict;
use warnings;
-use Scope::Upper qw/localize_delete/;
+use Scope::Upper qw/localize_delete UP HERE/;
use Test::More tests => 9;
{
local @a = (5 .. 7);
local $a[4] = 9;
- is $deleted, undef, 'localize_delete @tied_array, $existent => 0 [not deleted]';
+ is $deleted, undef, 'localize_delete @tied_array, $existent => HERE [not deleted]';
{
- localize_delete '@a', 4 => 0;
- is $deleted, 1, 'localize_delete @tied_array, $existent => 0 [deleted]';
- is_deeply \@a, [ 5 .. 7 ], 'localize_delete @tied_array, $existent => 0 [ok]';
+ localize_delete '@a', 4 => HERE;
+ is $deleted, 1, 'localize_delete @tied_array, $existent => HERE [deleted]';
+ is_deeply \@a, [ 5 .. 7 ], 'localize_delete @tied_array, $existent => HERE [ok]';
}
- is_deeply \@a, [ 5 .. 7, undef, 9 ], 'localize_elem @incomplete_tied_array, $nonexistent, 12 => 0 [end]';
- is $deleted, 1, 'localize_delete @tied_array, $existent => 0 [not more deleted]';
+ is_deeply \@a, [ 5 .. 7, undef, 9 ], 'localize_elem @incomplete_tied_array, $nonexistent, 12 => HERE [end]';
+ is $deleted, 1, 'localize_delete @tied_array, $existent => HERE [not more deleted]';
}
{
local @a = (4 .. 6);
local $a[4] = 7;
{
- localize_delete '@main::a', -1, 0;
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete @tied_array, $existent_neg => 0 [ok]';
+ localize_delete '@main::a', -1 => HERE;
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete @tied_array, $existent_neg => HERE [ok]';
}
- is_deeply \@a, [ 4 .. 6, undef, 7 ], 'localize_delete @tied_array, $existent_neg => 0 [end]';
+ is_deeply \@a, [ 4 .. 6, undef, 7 ], 'localize_delete @tied_array, $existent_neg => HERE [end]';
}
SKIP:
local @a = (4 .. 6);
local $a[4] = 7;
{
- localize_delete '@main::a', -1, 0;
- is_deeply \@a, [ 4 .. 6 ], 'localize_delete @tied_array_wo_neg, $existent_neg => 0 [ok]';
+ localize_delete '@main::a', -1 => HERE;
+ is_deeply \@a, [ 4 .. 6 ], 'localize_delete @tied_array_wo_neg, $existent_neg => HERE [ok]';
}
- is_deeply \@a, [ 4, 5, 7 ], 'localize_delete @tied_array_wo_neg, $existent_neg => 0 [end]';
+ is_deeply \@a, [ 4, 5, 7 ], 'localize_delete @tied_array_wo_neg, $existent_neg => HERE [end]';
}
is_deeply \@res, [ 7 ], 'unwind(-1)';
@res = (7, eval {
- unwind 100;
+ unwind 0;
8;
});
like $@, qr/^Can't\s+return\s+outside\s+a\s+subroutine/, 'unwind(100) croaks';
use Test::More 'no_plan';
-use Scope::Upper qw/reap/;
+use Scope::Upper qw/reap UP HERE/;
use lib 't/lib';
use Scope::Upper::TestGenerator;
local $Scope::Upper::TestGenerator::call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ "reap \\&check => $level;\n" ];
};
use Test::More 'no_plan';
-use Scope::Upper qw/unwind/;
+use Scope::Upper qw/unwind UP HERE/;
our ($call, @args, $args);
$call = sub {
my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
return [ [ "unwind(\@args => $level)\n", '' ] ];
};