This is 0.18

diff --git a/Changes b/Changes
index 9eeadad572da93b6d72fb776e1fd09c034d89764..6a27bd6e8ea15a7a1bd45c8ee08d5c8f28fb8608 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,17 @@
 Revision history for Scope-Upper
 
 Revision history for Scope-Upper
 

+0.18    2011-10-10 20:50 UTC
+        + Add : The uid() function returns an unique identifier for each dynamic
+                scope. The validate_uid() function can be used to check whether
+                one such identifier is valid (i.e. that the scope it refers to
+                is still alive).
+        + Chg : It is no longer possible on perl 5.6 to call goto() in an
+                uplevel callback to replace the uplevel call. This change was
+                needed in order to ensure consistency between platforms
+                regarding to the following fix just below.
+        + Fix : The uplevel() tests now pass on Windows.
+                Thanks C.H. Kang for bringing this to my attention.
+

 0.17    2011-10-03 21:45 UTC
         + Fix : uplevel() will now use the correct pad when executing its
                 callback. This fixes at least two issues :
 0.17    2011-10-03 21:45 UTC
         + Fix : uplevel() will now use the correct pad when executing its
                 callback. This fixes at least two issues :

diff --git a/META.json b/META.json
index 746f43ce3a3df135d4d19da7aee771453ca6f78c..d32dc6e57a4c78ab72c3db566c16e8f6b125dfbc 100644 (file)
--- a/META.json
+++ b/META.json
@@ -57,5 +57,5 @@
          "url" : "http://git.profvince.com/?p=perl%2Fmodules%2FScope-Upper.git"
       }
    },
          "url" : "http://git.profvince.com/?p=perl%2Fmodules%2FScope-Upper.git"
       }
    },

-   "version" : "0.17"
+   "version" : "0.18"

 }
 }

diff --git a/META.yml b/META.yml
index 36c1da147373dc19d7b8e549f120b687f65ac783..80f4c8d241221c6cfb71061d89dabf6ff813bd1d 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -32,4 +32,4 @@ resources:
   homepage: http://search.cpan.org/dist/Scope-Upper/
   license: http://dev.perl.org/licenses/
   repository: http://git.profvince.com/?p=perl%2Fmodules%2FScope-Upper.git
   homepage: http://search.cpan.org/dist/Scope-Upper/
   license: http://dev.perl.org/licenses/
   repository: http://git.profvince.com/?p=perl%2Fmodules%2FScope-Upper.git

-version: 0.17
+version: 0.18

diff --git a/README b/README
index faa4a768d5ef3ba30225e7fd74f0e87f3531abe1..7d441b7558fa36830cac4af0e6297130b6b95c27 100644 (file)
--- a/README
+++ b/README
@@ -2,14 +2,17 @@ NAME
     Scope::Upper - Act on upper scopes.
 
 VERSION
     Scope::Upper - Act on upper scopes.
 
 VERSION

-    Version 0.17
+    Version 0.18

 
 SYNOPSIS
     "reap", "localize", "localize_elem", "localize_delete" and "WORDS" :
 
         package Scope;
 
 
 SYNOPSIS
     "reap", "localize", "localize_elem", "localize_delete" and "WORDS" :
 
         package Scope;
 

-        use Scope::Upper qw<reap localize localize_elem localize_delete :words>;
+        use Scope::Upper qw<
+         reap localize localize_elem localize_delete
+         :words
+        >;

 
         sub new {
          my ($class, $name) = @_;
 
         sub new {
          my ($class, $name) = @_;


@@ -51,22 +54,22 @@ SYNOPSIS
         package UserLand;
 
         {
         package UserLand;
 
         {

-         Scope->new("top");      # initializes $UserLand::tag
+         Scope->new("top");    # initializes $UserLand::tag

 
          {
           Scope->catch;
 
          {
           Scope->catch;

-          my $one = 1 + undef;   # prints "top: Use of uninitialized value..."
+          my $one = 1 + undef; # prints "top: Use of uninitialized value..."

 
           {
            Scope->private;
            eval { require Cwd };
 
           {
            Scope->private;
            eval { require Cwd };

-           print $@;             # prints "Can't locate Cwd.pm in @INC (@INC contains:) at..."
-          }
+           print $@;           # prints "Can't locate Cwd.pm in @INC
+          }                    #         (@INC contains:) at..."

 
 

-          require Cwd;           # loads Cwd.pm
+          require Cwd;         # loads Cwd.pm

          }
 
          }
 

-        }                        # prints "top: done"
+        }                      # prints "top: done"

 
     "unwind" and "want_at" :
 
 
     "unwind" and "want_at" :
 


@@ -113,6 +116,28 @@ SYNOPSIS
 
         target('hello'); # "hello from Uplevel::target()"
 
 
         target('hello'); # "hello from Uplevel::target()"
 

+    "uid" and "validate_uid" :
+
+        use Scope::Upper qw<uid validate_uid>;
+
+        my $uid;
+
+        {
+         $uid = uid();
+         {
+          if ($uid eq uid(UP)) { # yes
+           ...
+          }
+          if (validate_uid($uid)) { # yes
+           ...
+          }
+         }
+        }
+
+        if (validate_uid($uid)) { # no
+         ...
+        }
+

 DESCRIPTION
     This module lets you defer actions *at run-time* that will take place
     when the control flow returns into an upper scope. Currently, you can:
 DESCRIPTION
     This module lets you defer actions *at run-time* that will take place
     when the control flow returns into an upper scope. Currently, you can:


@@ -127,7 +152,9 @@ DESCRIPTION
         which context was in use then with "want_at" ;
 
     *   execute a subroutine in the setting of an upper subroutine stack
         which context was in use then with "want_at" ;
 
     *   execute a subroutine in the setting of an upper subroutine stack

-        frame with "uplevel".
+        frame with "uplevel" ;
+
+    *   uniquely identify contextes with "uid" and "validate_uid".

 
 FUNCTIONS
     In all those functions, $context refers to the target scope.
 
 FUNCTIONS
     In all those functions, $context refers to the target scope.


@@ -325,6 +352,78 @@ FUNCTIONS
     Albeit the three exceptions listed above, it passes all the tests of
     Sub::Uplevel.
 
     Albeit the three exceptions listed above, it passes all the tests of
     Sub::Uplevel.
 

+  "uid $context"
+    Returns an unique identifier (UID) for the context (or dynamic scope)
+    pointed by $context, or for the current context if $context is omitted.
+    This UID will only be valid for the life time of the context it
+    represents, and another UID will be generated next time the same scope
+    is executed.
+
+        my $uid;
+
+        {
+         $uid = uid;
+         if ($uid eq uid()) { # yes, this is the same context
+          ...
+         }
+         {
+          if ($uid eq uid()) { # no, we are one scope below
+           ...
+          }
+          if ($uid eq uid(UP)) { # yes, UP points to the same scope as $uid
+           ...
+          }
+         }
+        }
+
+        # $uid is now invalid
+
+        {
+         if ($uid eq uid()) { # no, this is another block
+          ...
+         }
+        }
+
+    For example, each loop iteration gets its own UID :
+
+        my %uids;
+
+        for (1 .. 5) {
+         my $uid = uid;
+         $uids{$uid} = $_;
+        }
+
+        # %uids has 5 entries
+
+    The UIDs are not guaranteed to be numbers, so you must use the "eq"
+    operator to compare them.
+
+    To check whether a given UID is valid, you can use the "validate_uid"
+    function.
+
+  "validate_uid $uid"
+    Returns true if and only if $uid is the UID of a currently valid context
+    (that is, it designates a scope that is higher than the current one in
+    the call stack).
+
+        my $uid;
+
+        {
+         $uid = uid();
+         if (validate_uid($uid)) { # yes
+          ...
+         }
+         {
+          if (validate_uid($uid)) { # yes
+           ...
+          }
+         }
+        }
+
+        if (validate_uid($uid)) { # no
+         ...
+        }
+

 CONSTANTS
   "SU_THREADSAFE"
     True iff the module could have been built when thread-safety features.
 CONSTANTS
   "SU_THREADSAFE"
     True iff the module could have been built when thread-safety features.


@@ -375,13 +474,13 @@ WORDS
            {
             reap \&cleanup => $cxt;
             ...
            {
             reap \&cleanup => $cxt;
             ...

-           }     # $cxt = SCOPE(0), or HERE
+           }     # $cxt = SCOPE(0) = HERE

            ...
            ...

-          }->(); # $cxt = SCOPE(1), or UP, or SUB, or CALLER, or CALLER(0)
+          }->(); # $cxt = SCOPE(1) = UP = SUB = CALLER(0)

           ...
           ...

-         };      # $cxt = SCOPE(2), or UP UP, or UP SUB, or EVAL, or CALLER(1)
+         };      # $cxt = SCOPE(2) = UP UP =  UP SUB = EVAL = CALLER(1)

          ...
          ...

-        }->();   # $cxt = SCOPE(3), or SUB UP SUB, or SUB EVAL, or CALLER(2)
+        }->();   # $cxt = SCOPE(3) = SUB UP SUB = SUB EVAL = CALLER(2)

         ...
 
     Where "localize", "localize_elem" and "localize_delete" act depending on
         ...
 
     Where "localize", "localize_elem" and "localize_delete" act depending on


@@ -392,19 +491,19 @@ WORDS
           sub {
            {
             localize '$x' => 1 => $cxt;
           sub {
            {
             localize '$x' => 1 => $cxt;

-            # $cxt = SCOPE(0), or HERE
+            # $cxt = SCOPE(0) = HERE

             ...
            }
             ...
            }

-           # $cxt = SCOPE(1), or UP, or SUB, or CALLER, or CALLER(0)
+           # $cxt = SCOPE(1) = UP = SUB = CALLER(0)

            ...
           }->();
            ...
           }->();

-          # $cxt = SCOPE(2), or UP UP, or UP SUB, or EVAL, or CALLER(1)
+          # $cxt = SCOPE(2) = UP UP = UP SUB = EVAL = CALLER(1)

           ...
          };
           ...
          };

-         # $cxt = SCOPE(3), or SUB UP SUB, or SUB EVAL, or CALLER(2)
+         # $cxt = SCOPE(3) = SUB UP SUB = SUB EVAL = CALLER(2)

          ...
         }->();
          ...
         }->();

-        # $cxt = SCOPE(4), UP SUB UP SUB, or UP SUB EVAL, or UP CALLER(2), or TOP
+        # $cxt = SCOPE(4), UP SUB UP SUB = UP SUB EVAL = UP CALLER(2) = TOP

         ...
 
     Where "unwind", "want_at" and "uplevel" point to depending on the $cxt:
         ...
 
     Where "unwind", "want_at" and "uplevel" point to depending on the $cxt:


@@ -413,15 +512,15 @@ WORDS
          eval {
           sub {
            {
          eval {
           sub {
            {

-            unwind @things => $cxt;     # or uplevel { ... } $cxt;
+            unwind @things => $cxt;   # or uplevel { ... } $cxt;

             ...
            }
            ...
             ...
            }
            ...

-          }->(); # $cxt = SCOPE(0 .. 1), or HERE, or UP, or SUB, or CALLER(0)
+          }->(); # $cxt = SCOPE(0) = SCOPE(1) = HERE = UP = SUB = CALLER(0)

           ...
           ...

-         };      # $cxt = SCOPE(2), or UP UP, or UP SUB, or EVAL, or CALLER(1) (*)
+         };      # $cxt = SCOPE(2) = UP UP = UP SUB = EVAL = CALLER(1) (*)

          ...
          ...

-        }->();   # $cxt = SCOPE(3), or SUB UP SUB, or SUB EVAL, or CALLER(2)
+        }->();   # $cxt = SCOPE(3) = SUB UP SUB = SUB EVAL = CALLER(2)

         ...
 
         # (*) Note that uplevel() will croak if you pass that scope frame,
         ...
 
         # (*) Note that uplevel() will croak if you pass that scope frame,


@@ -472,9 +571,16 @@ CAVEATS
     may help to use a perl higher than 5.8.9 or 5.10.0, as they contain some
     context-related fixes.
 
     may help to use a perl higher than 5.8.9 or 5.10.0, as they contain some
     context-related fixes.
 

-    Calling "goto" to replace an "uplevel"'d code frame does not work when a
-    custom runloop is used or when debugging flags are set with "perl -D".
-    In those two cases, "uplevel" will look for a "goto &sub" statement in
+    Calling "goto" to replace an "uplevel"'d code frame does not work :
+
+    *   for a "perl" older than the 5.8 series ;
+
+    *   for a "DEBUGGING" "perl" run with debugging flags set (as in "perl
+        -D ...") ;
+
+    *   when the runloop callback is replaced by another module.
+
+    In those three cases, "uplevel" will look for a "goto &sub" statement in

     its callback and, if there is one, throw an exception before executing
     the code.
 
     its callback and, if there is one, throw an exception before executing
     the code.
 

diff --git a/lib/Scope/Upper.pm b/lib/Scope/Upper.pm
index 7ebfca3bd94e0847e9b0390ee8fe56268112aafa..b5936dbfa325253e1d2625c83205d71055c33cb7 100644 (file)
--- a/lib/Scope/Upper.pm
+++ b/lib/Scope/Upper.pm
@@ -9,13 +9,13 @@ Scope::Upper - Act on upper scopes.
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-Version 0.17
+Version 0.18

 
 =cut
 
 our $VERSION;
 BEGIN {
 
 =cut
 
 our $VERSION;
 BEGIN {

- $VERSION = '0.17';
+ $VERSION = '0.18';

 }
 
 =head1 SYNOPSIS
 }
 
 =head1 SYNOPSIS