From: Vincent Pit Date: Tue, 13 Jan 2009 23:02:29 +0000 (+0100) Subject: Replace raw level numbers by words, except in t/55-unwind-multi.t X-Git-Tag: v0.06~10 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=0a6221d3f467b5f819e3c119b4cda0218399cb51;p=perl%2Fmodules%2FScope-Upper.git Replace raw level numbers by words, except in t/55-unwind-multi.t --- diff --git a/lib/Scope/Upper.pm b/lib/Scope/Upper.pm index 4fb21d5..5156015 100644 --- a/lib/Scope/Upper.pm +++ b/lib/Scope/Upper.pm @@ -22,7 +22,7 @@ BEGIN { 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} } @@ -30,21 +30,21 @@ BEGIN { 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; @@ -82,6 +82,41 @@ This module lets you defer actions that will take place when the control flow re 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 + +Returns the level that currently represents the highest scope. + +=head2 C + +The current level. + +=head2 C + +The level of the scope just above C<$from>. + +=head2 C + +The level of the scope just below C<$from>. + +=head2 C + +The level of the closest subroutine context above C<$from>. + +=head2 C + +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 + +The level of the C<$stack>-th upper subroutine/eval/format context. +It kind of corresponds to the context represented by C, but while e.g. C refers to the caller context, C will refer to the top scope in the current context. + =head1 FUNCTIONS =cut @@ -114,7 +149,7 @@ A string beginning with a sigil, representing the symbol to localize and to assi If the sigil is C<'$'>, L follows the same syntax as C, 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. @@ -122,7 +157,7 @@ Other sigils (C<'@'>, C<'%'>, C<'&'> and C<'*'>) require C<$value> to be a refer When the symbol is given by a string, it is resolved when the actual localization takes place and not when C is called. This means that - sub tag { localize '$x', $_[0] => 1; } + sub tag { localize '$x', $_[0] => UP } will localize in the caller's namespace. @@ -166,7 +201,7 @@ This means that my $num = sub { my @a = ('a' .. 'z'); - unwind @a => 0; + unwind @a => HERE; }->(); will set C<$num> to C<'z'>. @@ -180,49 +215,11 @@ The previous example can then be "corrected" : 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 - -Returns the level that currently represents the highest scope. - -=head2 C - -The current level - i.e. C<0>. - -=head2 C - -The level of the scope just above C<$from>. - -=head2 C - -The level of the scope just below C<$from>. - -=head2 C - -The level of the closest subroutine context above C<$from>. - -=head2 C - -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 - -The level of the C<$stack>-th upper subroutine/eval/format context. -It kind of corresponds to the context represented by C, but while e.g. C refers to the caller context, C 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, L, L, L, L and L are only exported on request, either individually or by the tags C<':funcs'> and C<':all'>. @@ -248,7 +245,7 @@ Consider those examples: local $x = 0; { - reap sub { print $x } => 0; + reap sub { print $x } => HERE; local $x = 1; ... } @@ -256,7 +253,7 @@ Consider those examples: ... { local $x = 1; - reap sub { $x = 2 } => 0; + reap sub { $x = 2 } => HERE; ... } # $x is 0 diff --git a/samples/tag.pl b/samples/tag.pl index 03a2fbe..0e2e632 100644 --- a/samples/tag.pl +++ b/samples/tag.pl @@ -7,7 +7,7 @@ use warnings; 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} } @@ -15,21 +15,21 @@ sub set_tag { 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; diff --git a/t/06-want_at.t b/t/06-want_at.t index afd36bd..8262255 100644 --- a/t/06-want_at.t +++ b/t/06-want_at.t @@ -5,7 +5,7 @@ use warnings; 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) = @_; @@ -24,35 +24,35 @@ sub check { 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'; }; } }->(); diff --git a/t/11-reap-level.t b/t/11-reap-level.t index 8880ef3..35ac03b 100644 --- a/t/11-reap-level.t +++ b/t/11-reap-level.t @@ -5,13 +5,14 @@ use warnings; 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" ]; }; diff --git a/t/12-reap-block.t b/t/12-reap-block.t index 86e6022..7b15b64 100644 --- a/t/12-reap-block.t +++ b/t/12-reap-block.t @@ -5,13 +5,14 @@ use warnings; 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" ]; }; diff --git a/t/13-reap-ctl.t b/t/13-reap-ctl.t index 5dd5ea9..2d15fe5 100644 --- a/t/13-reap-ctl.t +++ b/t/13-reap-ctl.t @@ -5,7 +5,7 @@ use warnings; use Test::More tests => 38; -use Scope::Upper qw/reap/; +use Scope::Upper qw/reap UP HERE/; our ($x, $y); @@ -16,7 +16,7 @@ sub check { ++$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]'; @@ -39,7 +39,7 @@ $y = undef; { 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]'; @@ -64,7 +64,7 @@ $y = undef; { { 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]'; } @@ -88,7 +88,7 @@ $y = undef; { { 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]'; } @@ -109,7 +109,7 @@ $y = undef; { { 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]'; } @@ -129,7 +129,7 @@ $y = undef; 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 @@ -147,7 +147,7 @@ $y = undef; 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 diff --git a/t/15-reap-multi.t b/t/15-reap-multi.t index a3f7f3c..7fe8195 100644 --- a/t/15-reap-multi.t +++ b/t/15-reap-multi.t @@ -5,25 +5,25 @@ use warnings; 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'); @@ -38,13 +38,13 @@ $x = 0; 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'); @@ -55,7 +55,7 @@ $x = 0; { 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'); @@ -72,8 +72,8 @@ $x = 0; { 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'); @@ -86,10 +86,10 @@ $x = 0; 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; @@ -105,7 +105,7 @@ $x = 0; is($x, 0, 'start'); { { - add(1, 1); + add 1 => UP; is($x, 0, '1 didn\'t run'); } is($x, 0, '1 didn\'t run'); @@ -114,12 +114,12 @@ $x = 0; { { { - 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'); @@ -130,13 +130,13 @@ $x = 0; } 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'); @@ -148,21 +148,21 @@ is($x, 3, 'end'); 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'); } @@ -170,7 +170,7 @@ $x = 0; { is($x, 0, 'start'); local $_ = 3; - add(0, 1); + add 1 => HERE; is($_, 3, '$_ has the right value'); { local $_ = 5; diff --git a/t/20-localize-target.t b/t/20-localize-target.t index 5d23469..56ebd97 100644 --- a/t/20-localize-target.t +++ b/t/20-localize-target.t @@ -5,7 +5,7 @@ use warnings; use Test::More tests => 50; -use Scope::Upper qw/localize/; +use Scope::Upper qw/localize UP HERE/; # Scalars @@ -14,10 +14,10 @@ our $x; { 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} } @@ -25,40 +25,40 @@ 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: @@ -68,10 +68,10 @@ 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]'; }; } @@ -82,39 +82,39 @@ SKIP: 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 (*$) { @@ -124,7 +124,7 @@ sub callthrough (*$) { $val = eval "\\$val"; } local $x = 'x'; - localize $what, $val, 1; + localize $what, $val => UP; is $x, 'x', 'localize callthrough [not yet]'; } @@ -186,10 +186,10 @@ my $xa = [ 7 .. 9 ]; { 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]'; } { @@ -197,12 +197,12 @@ my $xa = [ 7 .. 9 ]; { 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 @@ -213,10 +213,10 @@ my $xh = { a => 5, c => 7 }; { 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]'; } { @@ -224,12 +224,12 @@ my $xh = { a => 5, c => 7 }; { 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 @@ -237,17 +237,17 @@ my $xh = { a => 5, c => 7 }; { 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]'; } diff --git a/t/21-localize-level.t b/t/21-localize-level.t index 27effbf..58c75d7 100644 --- a/t/21-localize-level.t +++ b/t/21-localize-level.t @@ -5,13 +5,14 @@ use warnings; 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" ]; }; diff --git a/t/22-localize-block.t b/t/22-localize-block.t index f9501e2..f48063a 100644 --- a/t/22-localize-block.t +++ b/t/22-localize-block.t @@ -5,13 +5,14 @@ use warnings; 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" ]; }; diff --git a/t/23-localize-ctl.t b/t/23-localize-ctl.t index c85c4a8..213df7f 100644 --- a/t/23-localize-ctl.t +++ b/t/23-localize-ctl.t @@ -5,7 +5,7 @@ use warnings; use Test::More tests => 44; -use Scope::Upper qw/localize/; +use Scope::Upper qw/localize UP HERE/; our ($x, $y); @@ -13,7 +13,7 @@ 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; @@ -31,7 +31,7 @@ LOOP: 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; @@ -47,7 +47,7 @@ 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; @@ -65,7 +65,7 @@ LOOP: 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; @@ -82,7 +82,7 @@ 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]'; @@ -105,7 +105,7 @@ $y = undef; { 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]'; @@ -130,7 +130,7 @@ $y = undef; { { 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]'; } @@ -154,7 +154,7 @@ $y = undef; { { 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]'; } @@ -175,7 +175,7 @@ $y = undef; { { 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]'; } diff --git a/t/25-localize-multi.t b/t/25-localize-multi.t index f205e75..e696b54 100644 --- a/t/25-localize-multi.t +++ b/t/25-localize-multi.t @@ -5,11 +5,11 @@ use warnings; 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; { @@ -17,7 +17,7 @@ $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'); @@ -43,10 +43,10 @@ $x = 0; { { 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'); @@ -59,10 +59,10 @@ $x = 0; 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'); diff --git a/t/30-localize_elem-target.t b/t/30-localize_elem-target.t index fe538e4..79ce8ee 100644 --- a/t/30-localize_elem-target.t +++ b/t/30-localize_elem-target.t @@ -5,7 +5,7 @@ use warnings; use Test::More tests => 21; -use Scope::Upper qw/localize_elem/; +use Scope::Upper qw/localize_elem UP HERE/; # Arrays @@ -14,37 +14,37 @@ our @a; { 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]'; } { @@ -52,12 +52,12 @@ our @a; { 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]'; } { @@ -65,12 +65,12 @@ our @a; { 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 @@ -80,19 +80,19 @@ our %h; { 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]'; } { @@ -100,11 +100,11 @@ our %h; { 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]'; } diff --git a/t/31-localize_elem-level.t b/t/31-localize_elem-level.t index b95acd6..a4845b2 100644 --- a/t/31-localize_elem-level.t +++ b/t/31-localize_elem-level.t @@ -5,7 +5,7 @@ use warnings; 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; @@ -14,6 +14,7 @@ our ($x, $testcase); 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" ]; }; @@ -40,6 +41,7 @@ for my $level (0 .. 2) { 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" ]; }; diff --git a/t/32-localize_elem-block.t b/t/32-localize_elem-block.t index 36014bd..f5a5147 100644 --- a/t/32-localize_elem-block.t +++ b/t/32-localize_elem-block.t @@ -5,7 +5,7 @@ use warnings; 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; @@ -18,6 +18,7 @@ our $testcase; local $Scope::Upper::TestGenerator::call = sub { my ($height, $level, $i) = @_; + $level = $level ? 'UP ' x $level : 'HERE'; return [ "localize_elem '\@a', 1 => 0 => $level;\n" ]; }; @@ -47,6 +48,7 @@ for my $level (0 .. 1) { local $Scope::Upper::TestGenerator::call = sub { my ($height, $level, $i) = @_; + $level = $level ? 'UP ' x $level : 'HERE'; return [ "localize_elem '%h', 'a' => 0 => $level;\n" ]; }; diff --git a/t/34-localize_elem-magic.t b/t/34-localize_elem-magic.t index 2754885..7a99222 100644 --- a/t/34-localize_elem-magic.t +++ b/t/34-localize_elem-magic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Scope::Upper qw/localize_elem/; +use Scope::Upper qw/localize_elem UP HERE/; use Test::More tests => 8; @@ -24,10 +24,10 @@ tie @a, 'Scope::Upper::Test::TiedArray'; { 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; @@ -37,7 +37,7 @@ 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"; @@ -67,7 +67,7 @@ my $time = time; 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]'; diff --git a/t/40-localize_delete-target.t b/t/40-localize_delete-target.t index 30468a1..24597b7 100644 --- a/t/40-localize_delete-target.t +++ b/t/40-localize_delete-target.t @@ -5,7 +5,7 @@ use warnings; use Test::More tests => 36; -use Scope::Upper qw/localize_delete/; +use Scope::Upper qw/localize_delete UP HERE/; # Arrays @@ -14,57 +14,57 @@ our @a; { 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]'; } { @@ -72,12 +72,12 @@ our @a; { 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]'; } { @@ -85,12 +85,12 @@ our @a; { 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]'; } { @@ -99,12 +99,12 @@ our @a; 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 @@ -114,19 +114,19 @@ our %h; { 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]'; } { @@ -134,34 +134,34 @@ our %h; { 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]'; diff --git a/t/41-localize_delete-level.t b/t/41-localize_delete-level.t index 799c055..acfb422 100644 --- a/t/41-localize_delete-level.t +++ b/t/41-localize_delete-level.t @@ -5,7 +5,7 @@ use warnings; 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; @@ -14,6 +14,7 @@ our ($x, $testcase); local $Scope::Upper::TestGenerator::call = sub { my ($height, $level, $i) = @_; + $level = $level ? 'UP ' x $level : 'HERE'; return [ "localize_delete '\@main::a', 2 => $level;\n" ]; }; @@ -41,6 +42,7 @@ for my $level (0 .. 2) { local $Scope::Upper::TestGenerator::call = sub { my ($height, $level, $i) = @_; + $level = $level ? 'UP ' x $level : 'HERE'; return [ "localize_delete '%main::h', 'a' => $level;\n" ]; }; diff --git a/t/44-localize_delete-magic.t b/t/44-localize_delete-magic.t index 0b93050..affe05b 100644 --- a/t/44-localize_delete-magic.t +++ b/t/44-localize_delete-magic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Scope::Upper qw/localize_delete/; +use Scope::Upper qw/localize_delete UP HERE/; use Test::More tests => 9; @@ -29,24 +29,24 @@ tie @a, 'Scope::Upper::Test::TiedArray'; { 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: @@ -56,8 +56,8 @@ 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]'; } diff --git a/t/50-unwind-target.t b/t/50-unwind-target.t index 7e43baa..4304240 100644 --- a/t/50-unwind-target.t +++ b/t/50-unwind-target.t @@ -22,7 +22,7 @@ is_deeply \@res, [ 7 ], 'unwind()'; 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'; diff --git a/t/81-stress-level.t b/t/81-stress-level.t index 5dd5d43..117e5c4 100644 --- a/t/81-stress-level.t +++ b/t/81-stress-level.t @@ -5,13 +5,14 @@ use warnings; 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" ]; }; diff --git a/t/85-stress-unwind.t b/t/85-stress-unwind.t index 5a59e7a..c4712e5 100644 --- a/t/85-stress-unwind.t +++ b/t/85-stress-unwind.t @@ -5,12 +5,13 @@ use warnings; 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", '' ] ]; };