]> 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;
 
-    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<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
@@ -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,
 
-    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<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.
 
@@ -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<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'>.
@@ -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
index 03a2fbed8d1a791d28adb9924d561dcec3f87060..0e2e63279d56f1250a68e7976d3cbfc8ef26d9da 100644 (file)
@@ -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;
index afd36bdb336c416d4e8c6239a1505c57c01525bf..8262255907b626888a11c959683ce53e13af6cbb 100644 (file)
@@ -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';
   };
  }
 }->();
index 8880ef3d11327f9067eab87e437cd0715707b41d..35ac03b3e1ca19895125338fe37ba7a0763a021e 100644 (file)
@@ -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" ];
 };
 
index 86e602210349e3dff90fc9abe5fd892c373a7336..7b15b64bdddf215f8e81afb51b395b58be9cacce 100644 (file)
@@ -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" ];
 };
 
index 5dd5ea91d099bc4aedb3229ac80d896664192577..2d15fe568bbd099f97ebd1b901a10e96206e4775 100644 (file)
@@ -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
index a3f7f3ce8d5c37db7d33b8bdd16aca13a931ed9a..7fe8195c06be8661913668f980435d649d5dfae1 100644 (file)
@@ -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;
index 5d23469adb1b554973dde9cefc7612213d9e0f64..56ebd978df5f747f571b6585808ddbb1dda2eb76 100644 (file)
@@ -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]';
 }
index 27effbf3bac4036052f45efaac21d0dfab6943b6..58c75d7dc2aa6e4b5e90c07ce6a6d9d737e38541 100644 (file)
@@ -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" ];
 }; 
 
index f9501e2b9d333f38f83d8a703a4c4f3f3914ae99..f48063a2f6b2ec3165eeab0d54496b35fa325f3f 100644 (file)
@@ -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" ];
 };
 
index c85c4a8cf9f6a5a249aae4d07c99fc32ef43fe4b..213df7f2fa99e2a67eb8a49da936658bbbfab5b6 100644 (file)
@@ -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]';
    }
index f205e75c9902e5258459d00611384b22be18f237..e696b547c518da132345159a28ca09fd98d7a34e 100644 (file)
@@ -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');
index fe538e40ddb7ff92cfb6be93982f0cfcee2d114f..79ce8eec59c6bc9c70ed010b4ca47d14f18f5caa 100644 (file)
@@ -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]';
 }
 
index b95acd694e9256cad9794f68acc819082ef53698..a4845b2541a26158bf321b0210b4040ac3cc19b5 100644 (file)
@@ -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" ];
 }; 
 
index 36014bda538d10da224b1468787338c412cd984f..f5a5147a2c21c02817b899a9d1d24a4e0b289edf 100644 (file)
@@ -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" ];
 };
 
index 2754885a41aa7b04fa6412ec646690271ad5d103..7a99222427567b767d7510b0d9804ef1ad17898e 100644 (file)
@@ -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]';
index 30468a1169ee13df4d85ae45c27ea5e435791769..24597b7d036968030caeff7337cf707db0df637c 100644 (file)
@@ -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]';
index 799c0556ce7e2bc20ef261fe75e8b817c5fa3d0e..acfb4226bcb40667047e2ad5cf1344211f35c8ec 100644 (file)
@@ -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" ];
 };
 
index 0b930505f4a20896fd08684df21b4267de3c7285..affe05b120cc71e85210e10fae51e4ee6ee5fc2f 100644 (file)
@@ -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]';
 }
index 7e43baa6247d553bf757fd6a5ce20ea6c8cc0036..430424091d7505145fb518c829d226b8c701300a 100644 (file)
@@ -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';
index 5dd5d435d18584dba18c043620f5e1c886c1e92b..117e5c46d882fd4ad0452b573f4cb79e6d20b5f4 100644 (file)
@@ -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" ];
 };
 
index 5a59e7a01af26eae18b5be2d8682d2f2811d6561..c4712e55026059effd61cd0897b1e62f5981a0dc 100644 (file)
@@ -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", '' ] ];
 };