]> git.vpit.fr Git - perl/modules/Scope-Upper.git/commitdiff
Replace raw level numbers by words, except in t/55-unwind-multi.t
authorVincent Pit <vince@profvince.com>
Tue, 13 Jan 2009 23:02:29 +0000 (00:02 +0100)
committerVincent Pit <vince@profvince.com>
Tue, 13 Jan 2009 23:59:48 +0000 (00:59 +0100)
22 files changed:
lib/Scope/Upper.pm
samples/tag.pl
t/06-want_at.t
t/11-reap-level.t
t/12-reap-block.t
t/13-reap-ctl.t
t/15-reap-multi.t
t/20-localize-target.t
t/21-localize-level.t
t/22-localize-block.t
t/23-localize-ctl.t
t/25-localize-multi.t
t/30-localize_elem-target.t
t/31-localize_elem-level.t
t/32-localize_elem-block.t
t/34-localize_elem-magic.t
t/40-localize_delete-target.t
t/41-localize_delete-level.t
t/44-localize_delete-magic.t
t/50-unwind-target.t
t/81-stress-level.t
t/85-stress-unwind.t

index 4fb21d543a3f1adcfb791adf73fe7c79c144f9c5..51560158b054cb9532ebacbeb1b131fe34bed065 100644 (file)
@@ -22,7 +22,7 @@ BEGIN {
 
     package X;
 
 
     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} }
 
 
     sub desc { shift->{desc} }
 
@@ -30,21 +30,21 @@ BEGIN {
      my ($desc) = @_;
 
      # First localize $x so that it gets destroyed last
      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";
 
      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('', @_));
 
      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;
     }
 
     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.
 
 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
 =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</localize> follows the same syntax as C<local $x = $value>, i.e. C<$value> isn't dereferenced.
 For example,
 
 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.
 
 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<localize> is called.
 This means that
 
 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.
 
 
 will localize in the caller's namespace.
 
@@ -166,7 +201,7 @@ This means that
 
     my $num = sub {
      my @a = ('a' .. 'z');
 
     my $num = sub {
      my @a = ('a' .. 'z');
-     unwind @a => 0;
+     unwind @a => HERE;
     }->();
 
 will set C<$num> to C<'z'>.
     }->();
 
 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');
 
     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>.
 
     }->();
 
 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'>.
 =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'>.
@@ -248,7 +245,7 @@ Consider those examples:
 
     local $x = 0;
     {
 
     local $x = 0;
     {
-     reap sub { print $x } => 0;
+     reap sub { print $x } => HERE;
      local $x = 1;
      ...
     }
      local $x = 1;
      ...
     }
@@ -256,7 +253,7 @@ Consider those examples:
     ...
     {
      local $x = 1;
     ...
     {
      local $x = 1;
-     reap sub { $x = 2 } => 0;
+     reap sub { $x = 2 } => HERE;
      ...
     }
     # $x is 0
      ...
     }
     # $x is 0
index 03a2fbed8d1a791d28adb9924d561dcec3f87060..0e2e63279d56f1250a68e7976d3cbfc8ef26d9da 100644 (file)
@@ -7,7 +7,7 @@ use warnings;
 
 use blib;
 
 
 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} }
 
 
 sub desc { shift->{desc} }
 
@@ -15,21 +15,21 @@ sub set_tag {
  my ($desc) = @_;
 
  # First localize $x so that it gets destroyed last
  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";
 
  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('', @_));
 
  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;
 }
 
 package main;
index afd36bdb336c416d4e8c6239a1505c57c01525bf..8262255907b626888a11c959683ce53e13af6cbb 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More tests => 19;
 
 
 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) = @_;
 
 sub check {
  my ($w, $exp, $desc) = @_;
@@ -24,35 +24,35 @@ sub check {
 
 my $w;
 
 
 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';
  {
 
 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) {
   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 "
   }
   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 {
   ";
   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';
   };
  }
 }->();
   };
  }
 }->();
index 8880ef3d11327f9067eab87e437cd0715707b41d..35ac03b3e1ca19895125338fe37ba7a0763a021e 100644 (file)
@@ -5,13 +5,14 @@ use warnings;
 
 use Test::More 'no_plan'; 
 
 
 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) = @_;
 
 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" ];
 };
 
  return [ "reap \\&check => $level;\n" ];
 };
 
index 86e602210349e3dff90fc9abe5fd892c373a7336..7b15b64bdddf215f8e81afb51b395b58be9cacce 100644 (file)
@@ -5,13 +5,14 @@ use warnings;
 
 use Test::More 'no_plan'; 
 
 
 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) = @_;
 
 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" ];
 };
 
  return [ "reap \\&check => $level;\n" ];
 };
 
index 5dd5ea91d099bc4aedb3229ac80d896664192577..2d15fe568bbd099f97ebd1b901a10e96206e4775 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More tests => 38;
 
 
 use Test::More tests => 38;
 
-use Scope::Upper qw/reap/;
+use Scope::Upper qw/reap UP HERE/;
 
 our ($x, $y);
 
 
 our ($x, $y);
 
@@ -16,7 +16,7 @@ sub check { ++$y }
  {
   local $x = 2;
   {
  {
   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]';
   }
   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;
    {
   {
    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]';
    }
    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;
    {
     {
      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]';
     }
      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;
   {
    {
     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]';
    }
     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;
   {
    {
     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]';
    }
     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;
   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
    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;
   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
    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
index a3f7f3ce8d5c37db7d33b8bdd16aca13a931ed9a..7fe8195c06be8661913668f980435d649d5dfae1 100644 (file)
@@ -5,25 +5,25 @@ use warnings;
 
 use Test::More tests => 8 + 18 + 4 + 8 + 11 + 5 + 17;
 
 
 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;
 
 
 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');
  {
 
 $x = 0;
 {
  is($x, 0, 'start');
  {
-  add(0, 1);
+  add 1 => HERE;
   is($x, 0, '1 didn\'t run');
   {
   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');
   {
    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');
    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');
  {
  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');
   {
   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');
    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');
   {
    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');
    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');
  {
 {
  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');
   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;
  local $_ = 3;
  {
   local $_ = 5;
-  add(0, 1);
+  add 1 => HERE;
   is($_, 5, '$_ has the right value');
   local $_ = 7;
   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($_, 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');
  {
   {
  is($x, 0, 'start');
  {
   {
-   add(1, 1);
+   add 1 => UP;
    is($x, 0, '1 didn\'t run');
   }
   is($x, 0, '1 didn\'t run');
    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');
    {
     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, 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');
 
 }
 is($x, 7, 'end');
 
-sub bleh { add(1, 2); }
+sub bleh { add 2 => UP; }
 
 $x = 0;
 {
  is($x, 0, 'start');
  {
 
 $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');
   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;
 sub bar {
  is($_, 7, '$_ has the right value');
  local $_ = 9;
- add(2, 4);
+ add 4 => UP UP;
  is($_, 9, '$_ has the right value');
  is($_, 9, '$_ has the right value');
- add(3, 8);
+ add 8 => UP UP UP;
  is($_, 9, '$_ has the right value');
 }
 
 sub foo {
  local $_ = 7;
  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');
  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($_, 7, '$_ has the right value');
 }
 
@@ -170,7 +170,7 @@ $x = 0;
 {
  is($x, 0, 'start');
  local $_ = 3;
 {
  is($x, 0, 'start');
  local $_ = 3;
- add(0, 1);
+ add 1 => HERE;
  is($_, 3, '$_ has the right value');
  {
   local $_ = 5;
  is($_, 3, '$_ has the right value');
  {
   local $_ = 5;
index 5d23469adb1b554973dde9cefc7612213d9e0f64..56ebd978df5f747f571b6585808ddbb1dda2eb76 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More tests => 50;
 
 
 use Test::More tests => 50;
 
-use Scope::Upper qw/localize/;
+use Scope::Upper qw/localize UP HERE/;
 
 # Scalars
 
 
 # Scalars
 
@@ -14,10 +14,10 @@ our $x;
 {
  local $x = 2;
  {
 {
  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} }
 }
 
 sub _t { shift->{t} }
@@ -25,40 +25,40 @@ sub _t { shift->{t} }
 {
  local $x;
  {
 {
  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;
 }
 
 {
  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;
  {
 }
 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;
  {
 }
 
 {
  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:
 }
 
 SKIP:
@@ -68,10 +68,10 @@ SKIP:
   no strict 'refs';
   local ${''} = 9;
   {
   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;
   {
   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;
  {
  };
 }
 
 {
  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;
  {
 }
 
 {
  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;
  {
 }
 
 {
  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 (*$) {
 }
 
 sub callthrough (*$) {
@@ -124,7 +124,7 @@ sub callthrough (*$) {
   $val  = eval "\\$val";
  }
  local $x = 'x';
   $val  = eval "\\$val";
  }
  local $x = 'x';
- localize $what, $val, 1;
+ localize $what, $val => UP;
  is $x, 'x', 'localize callthrough [not yet]';
 }
 
  is $x, 'x', 'localize callthrough [not yet]';
 }
 
@@ -186,10 +186,10 @@ my $xa = [ 7 .. 9 ];
 {
  local @a = (4 .. 6);
  {
 {
  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);
   {
  {
   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
 }
 
 # Hashes
@@ -213,10 +213,10 @@ my $xh = { a => 5, c => 7 };
 {
  local %h = (a => 1, b => 2);
  {
 {
  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);
   {
  {
   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
 }
 
 # Code
@@ -237,17 +237,17 @@ my $xh = { a => 5, c => 7 };
 {
  local *foo = sub { 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 };
  {
 }
 
 {
  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]';
 }
 }
index 27effbf3bac4036052f45efaac21d0dfab6943b6..58c75d7dc2aa6e4b5e90c07ce6a6d9d737e38541 100644 (file)
@@ -5,13 +5,14 @@ use warnings;
 
 use Test::More 'no_plan'; 
 
 
 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) = @_;
 
 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" ];
 }; 
 
  return [ "localize '\$main::y' => 1 => $level;\n" ];
 }; 
 
index f9501e2b9d333f38f83d8a703a4c4f3f3914ae99..f48063a2f6b2ec3165eeab0d54496b35fa325f3f 100644 (file)
@@ -5,13 +5,14 @@ use warnings;
 
 use Test::More 'no_plan'; 
 
 
 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) = @_;
 
 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" ];
 };
 
  return [ "localize '\$x' => 0 => $level;\n" ];
 };
 
index c85c4a8cf9f6a5a249aae4d07c99fc32ef43fe4b..213df7f2fa99e2a67eb8a49da936658bbbfab5b6 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More tests => 44;
 
 
 use Test::More tests => 44;
 
-use Scope::Upper qw/localize/;
+use Scope::Upper qw/localize UP HERE/;
 
 our ($x, $y);
 
 
 our ($x, $y);
 
@@ -13,7 +13,7 @@ our ($x, $y);
  local $x = 1;
  {
   local $x = 2;
  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;
   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;
   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;
    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;
  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;
   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;
   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;
    is $x, 3, 'next 1 [ok - x]';
    is $y, 0, 'next 1 [ok - y]';
    next LOOP;
@@ -82,7 +82,7 @@ LOOP:
  {
   local $x = 2;
   {
  {
   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]';
   }
   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;
    {
   {
    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]';
    }
    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;
    {
     {
      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]';
     }
      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;
   {
    {
     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]';
    }
     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;
   {
    {
     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]';
    }
     is $x, 3,     'die - reap inside eval [not yet 1 - x]';
     is $y, undef, 'die - reap inside eval [not yet 1 - y]';
    }
index f205e75c9902e5258459d00611384b22be18f237..e696b547c518da132345159a28ca09fd98d7a34e 100644 (file)
@@ -5,11 +5,11 @@ use warnings;
 
 use Test::More tests => 10 + 5 + 6;
 
 
 use Test::More tests => 10 + 5 + 6;
 
-use Scope::Upper qw/localize/;
+use Scope::Upper qw/localize UP HERE/;
 
 our $x;
 
 
 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;
 {
 
 $x = 0;
 {
@@ -17,7 +17,7 @@ $x = 0;
  local $x = 7;
  {
   local $x = 8;
  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');
   is($x, 8, 'not localized');
   local $x = 9;
   is($x, 9, 'not localized');
@@ -43,10 +43,10 @@ $x = 0;
  {
   {
    local $x = 8;
  {
   {
    local $x = 8;
-   loc(2, 1);
+   loc 1 => UP UP;
    is($x, 8, 'not localized');
   }
    is($x, 8, 'not localized');
   }
-  loc(0, 2);
+  loc 2 => HERE;
   is($x, 2, 'localized to 2');
  }
  is($x, 1, 'localized to 1');
   is($x, 2, 'localized to 2');
  }
  is($x, 1, 'localized to 1');
@@ -59,10 +59,10 @@ $x = 0;
  local $x;
  {
   {
  local $x;
  {
   {
-   loc(2, 1);
+   loc 1 => UP UP;
    is($x, undef, 'not localized');
    local $x;
    is($x, undef, 'not localized');
    local $x;
-   loc(1, 2);
+   loc 2 => UP;
    is($x, undef, 'not localized');
   }
   is($x, 2, 'localized to 2');
    is($x, undef, 'not localized');
   }
   is($x, 2, 'localized to 2');
index fe538e40ddb7ff92cfb6be93982f0cfcee2d114f..79ce8eec59c6bc9c70ed010b4ca47d14f18f5caa 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More tests => 21;
 
 
 use Test::More tests => 21;
 
-use Scope::Upper qw/localize_elem/;
+use Scope::Upper qw/localize_elem UP HERE/;
 
 # Arrays
 
 
 # Arrays
 
@@ -14,37 +14,37 @@ our @a;
 {
  local @a = (4 .. 6);
  {
 {
  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);
  {
 }
 
 {
  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);
  {
 }
 
 {
  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);
  {
 }
 
 {
  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);
   {
  {
   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);
   {
  {
   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
 }
 
 # Hashes
@@ -80,19 +80,19 @@ our %h;
 {
  local %h = (a => 1, b => 2);
  {
 {
  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);
  {
 }
 
 {
  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);
   {
  {
   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]';
 }
 
 }
 
index b95acd694e9256cad9794f68acc819082ef53698..a4845b2541a26158bf321b0210b4040ac3cc19b5 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More 'no_plan'; 
 
 
 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;
 
 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) = @_;
 
 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" ];
 };
 
  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) = @_;
 
 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" ];
 }; 
 
  return [ "localize_elem '%main::h', 'a' => 1 => $level;\n" ];
 }; 
 
index 36014bda538d10da224b1468787338c412cd984f..f5a5147a2c21c02817b899a9d1d24a4e0b289edf 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More 'no_plan'; 
 
 
 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;
 
 use lib 't/lib';
 use Scope::Upper::TestGenerator;
@@ -18,6 +18,7 @@ our $testcase;
 
 local $Scope::Upper::TestGenerator::call = sub {
  my ($height, $level, $i) = @_;
 
 local $Scope::Upper::TestGenerator::call = sub {
  my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
  return [ "localize_elem '\@a', 1 => 0 => $level;\n" ];
 };
 
  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) = @_;
 
 local $Scope::Upper::TestGenerator::call = sub {
  my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
  return [ "localize_elem '%h', 'a' => 0 => $level;\n" ];
 };
 
  return [ "localize_elem '%h', 'a' => 0 => $level;\n" ];
 };
 
index 2754885a41aa7b04fa6412ec646690271ad5d103..7a99222427567b767d7510b0d9804ef1ad17898e 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 
-use Scope::Upper qw/localize_elem/;
+use Scope::Upper qw/localize_elem UP HERE/;
 
 use Test::More tests => 8;
 
 
 use Test::More tests => 8;
 
@@ -24,10 +24,10 @@ tie @a, 'Scope::Upper::Test::TiedArray';
 {
  local @a = (5 .. 7);
  {
 {
  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;
 }
 
 our $x;
@@ -37,7 +37,7 @@ our $x;
  local $SIG{__WARN__} = sub { };
  {
   {
  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";
    is $x, undef, 'localize_elem $SIG{__WARN__} [not yet]';
   }
   warn "1\n";
@@ -67,7 +67,7 @@ my $time = time;
  local $ENV{SCOPE_UPPER_TEST};
  {
   {
  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]';
    runperl $time, 0, 'localize_elem $ENV{SCOPE_UPPER_TEST} [not yet]';
   }
   runperl $time, 1, 'localize_elem $ENV{SCOPE_UPPER_TEST} [ok]';
index 30468a1169ee13df4d85ae45c27ea5e435791769..24597b7d036968030caeff7337cf707db0df637c 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More tests => 36;
 
 
 use Test::More tests => 36;
 
-use Scope::Upper qw/localize_delete/;
+use Scope::Upper qw/localize_delete UP HERE/;
 
 # Arrays
 
 
 # Arrays
 
@@ -14,57 +14,57 @@ our @a;
 {
  local @a = (4 .. 6);
  {
 {
  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);
  {
 }
 
 {
  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;
  {
 }
 
 {
  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);
  {
 }
 
 {
  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;
  {
 }
 
 {
  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);
  {
 }
 
 {
  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);
   {
  {
   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);
   {
  {
   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;
   {
   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
 }
 
 # Hashes
@@ -114,19 +114,19 @@ our %h;
 {
  local %h = (a => 1, b => 2);
  {
 {
  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);
  {
 }
 
 {
  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);
   {
  {
   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;
 {
 }
 
 # 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 };
 {
 
 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]';
index 799c0556ce7e2bc20ef261fe75e8b817c5fa3d0e..acfb4226bcb40667047e2ad5cf1344211f35c8ec 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use Test::More 'no_plan';
 
 
 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;
 
 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) = @_;
 
 local $Scope::Upper::TestGenerator::call = sub {
  my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
  return [ "localize_delete '\@main::a', 2 => $level;\n" ];
 };
 
  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) = @_;
 
 local $Scope::Upper::TestGenerator::call = sub {
  my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
  return [ "localize_delete '%main::h', 'a' => $level;\n" ];
 };
 
  return [ "localize_delete '%main::h', 'a' => $level;\n" ];
 };
 
index 0b930505f4a20896fd08684df21b4267de3c7285..affe05b120cc71e85210e10fae51e4ee6ee5fc2f 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 
-use Scope::Upper qw/localize_delete/;
+use Scope::Upper qw/localize_delete UP HERE/;
 
 use Test::More tests => 9;
 
 
 use Test::More tests => 9;
 
@@ -29,24 +29,24 @@ tie @a, 'Scope::Upper::Test::TiedArray';
 {
  local @a = (5 .. 7);
  local $a[4] = 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;
  {
 }
 
 {
  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:
 }
 
 SKIP:
@@ -56,8 +56,8 @@ SKIP:
  local @a = (4 .. 6);
  local $a[4] = 7;
  {
  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]';
 }
 }
index 7e43baa6247d553bf757fd6a5ce20ea6c8cc0036..430424091d7505145fb518c829d226b8c701300a 100644 (file)
@@ -22,7 +22,7 @@ is_deeply \@res, [ 7 ], 'unwind()';
 is_deeply \@res, [ 7 ], 'unwind(-1)';
 
 @res = (7, eval {
 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';
  8;
 });
 like $@, qr/^Can't\s+return\s+outside\s+a\s+subroutine/, 'unwind(100) croaks';
index 5dd5d435d18584dba18c043620f5e1c886c1e92b..117e5c46d882fd4ad0452b573f4cb79e6d20b5f4 100644 (file)
@@ -5,13 +5,14 @@ use warnings;
 
 use Test::More 'no_plan';
 
 
 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) = @_;
 
 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" ];
 };
 
  return [ "reap \\&check => $level;\n" ];
 };
 
index 5a59e7a01af26eae18b5be2d8682d2f2811d6561..c4712e55026059effd61cd0897b1e62f5981a0dc 100644 (file)
@@ -5,12 +5,13 @@ use warnings;
 
 use Test::More 'no_plan';
 
 
 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) = @_;
 
 our ($call, @args, $args);
 
 $call = sub {
  my ($height, $level, $i) = @_;
+ $level = $level ? 'UP ' x $level : 'HERE';
  return [ [ "unwind(\@args => $level)\n", '' ] ];
 };
 
  return [ [ "unwind(\@args => $level)\n", '' ] ];
 };