r38732 - in /trunk/libpadwalker-perl: Changes PadWalker.pm PadWalker.xs README debian/README.source debian/changelog debian/control debian/copyright debian/patches/ debian/rules t/closure.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Fri Jun 26 15:19:15 UTC 2009


Author: jawnsy-guest
Date: Fri Jun 26 15:19:09 2009
New Revision: 38732

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38732
Log:
* New upstream release
  + New feature, set_closed_over
* Removed quilt stuff, since the patch is now applied upstream
* Standards version 3.8.2
* Added /me to copyright and uploaders
* Updated description (hopefully it's a bit more clear)
* Debhelper dependency back to 7, since quilt isn't used anymore

Removed:
    trunk/libpadwalker-perl/debian/README.source
    trunk/libpadwalker-perl/debian/patches/
Modified:
    trunk/libpadwalker-perl/Changes
    trunk/libpadwalker-perl/PadWalker.pm
    trunk/libpadwalker-perl/PadWalker.xs
    trunk/libpadwalker-perl/README
    trunk/libpadwalker-perl/debian/changelog
    trunk/libpadwalker-perl/debian/control
    trunk/libpadwalker-perl/debian/copyright
    trunk/libpadwalker-perl/debian/rules
    trunk/libpadwalker-perl/t/closure.t

Modified: trunk/libpadwalker-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/Changes?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/Changes (original)
+++ trunk/libpadwalker-perl/Changes Fri Jun 26 15:19:09 2009
@@ -120,3 +120,9 @@
 1.7  Mon Feb  4 09:56:31 GMT 2008
 	- Keep up with changes in blead post-5.10 (@33030)
 
+1.8  Thu 25 Jun 2009 21:17:17 BST
+	- Apply patches from doy (#41710) and nothingmuch (set_closed_over).
+
+1.9  Fri 26 Jun 2009 10:01:17 BST
+	- Identical to 1.8, but with the bogus metadata ._ files removed
+	  from the distributed tar file.

Modified: trunk/libpadwalker-perl/PadWalker.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/PadWalker.pm?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/PadWalker.pm (original)
+++ trunk/libpadwalker-perl/PadWalker.pm Fri Jun 26 15:19:09 2009
@@ -9,10 +9,10 @@
 require 5.008;
 
 @ISA = qw(Exporter DynaLoader);
- at EXPORT_OK = qw(peek_my peek_our closed_over peek_sub var_name);
+ at EXPORT_OK = qw(peek_my peek_our closed_over peek_sub var_name set_closed_over);
 %EXPORT_TAGS = (all => \@EXPORT_OK);
 
-$VERSION = '1.7';
+$VERSION = '1.9';
 
 bootstrap PadWalker $VERSION;
 
@@ -112,6 +112,12 @@
 reasonable uses: see L<Data::Dump::Streamer>, for example (a future version
 of which may in fact use C<closed_over>).
 
+=item set_closed_over SUB, HASH_REF
+
+C<set_closed_over> reassigns the pad variables that are closed over by the subroutine.
+
+The second argument is a hash of references, much like the one returned from C<closed_over>.
+
 =item var_name LEVEL, VAR_REF
 
 =item var_name SUB,   VAR_REF
@@ -137,9 +143,9 @@
 
 Robin Houston <robin at cpan.org>
 
-With contributions from Richard Soberberg, bug-spotting
-from Peter Scott and Dave Mitchell, and suggestions from
-demerphq.
+With contributions from Richard Soberberg, Jesse Luehrs and
+Yuval Kogman, bug-spotting from Peter Scott, Dave Mitchell and
+Goro Fuji, and suggestions from demerphq.
 
 =head1 SEE ALSO
 
@@ -147,7 +153,7 @@
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000-2007, Robin Houston. All Rights Reserved.
+Copyright (c) 2000-2009, Robin Houston. All Rights Reserved.
 This module is free software. It may be used, redistributed
 and/or modified under the same terms as Perl itself.
 

Modified: trunk/libpadwalker-perl/PadWalker.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/PadWalker.xs?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/PadWalker.xs (original)
+++ trunk/libpadwalker-perl/PadWalker.xs Fri Jun 26 15:19:09 2009
@@ -358,9 +358,17 @@
 get_closed_over(CV *cv, HV *hash, HV *indices)
 {
     I32 i;
-    U32 val_depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
-    AV *pad_namelist = (AV*) *av_fetch(CvPADLIST(cv), 0, FALSE);
-    AV *pad_vallist  = (AV*) *av_fetch(CvPADLIST(cv), val_depth, FALSE);
+    U32 val_depth;
+    AV *pad_namelist;
+    AV *pad_vallist;
+
+    if (!CvPADLIST(cv)) {
+        return;
+    }
+
+    val_depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
+    pad_namelist = (AV*) *av_fetch(CvPADLIST(cv), 0, FALSE);
+    pad_vallist  = (AV*) *av_fetch(CvPADLIST(cv), val_depth, FALSE);
 
     debug_print(("av_len(CvPADLIST(cv)) = %ld\n", av_len(CvPADLIST(cv)) ));
     
@@ -488,6 +496,52 @@
     SvREFCNT_dec((SV*) ignore);
     EXTEND(SP, 1);
     PUSHs(sv_2mortal(newRV_noinc((SV*)ret)));
+
+
+
+void
+set_closed_over(sv, pad)
+SV* sv;
+HV* pad;
+  PREINIT:
+    I32 i;
+    CV *cv = (CV *)SvRV(sv);
+    U32 val_depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
+    AV *pad_namelist = (AV*) *av_fetch(CvPADLIST(cv), 0, FALSE);
+    AV *pad_vallist  = (AV*) *av_fetch(CvPADLIST(cv), val_depth, FALSE);
+  CODE:
+    for (i=av_len(pad_namelist); i>=0; --i) {
+      SV** name_ptr = av_fetch(pad_namelist, i, 0);
+
+      if (name_ptr && SvPOKp(*name_ptr)) {
+        SV*   name_sv   = *name_ptr;
+        char* name_str  = SvPVX(name_sv);
+        STRLEN name_len = strlen(name_str);
+
+        if (SvFAKE(name_sv) && 0 == (SvFLAGS(name_sv) & SVpad_OUR)) {
+          SV **restore_ref = hv_fetch(pad, name_str, name_len, FALSE);
+          if ( restore_ref ) {
+            if ( SvROK(*restore_ref) ) {
+              SV *restore = SvRV(*restore_ref);
+              SV **orig = av_fetch(pad_vallist, i, 0);
+
+              if ( !orig || !*orig || strcmp(sv_reftype(*orig, 0), sv_reftype(restore, 0)) == 0 ) {
+                SvREFCNT_inc(restore);
+
+                if ( av_store(pad_vallist, i, restore) == NULL )
+                  SvREFCNT_dec(restore);
+              } else {
+                croak("Incorrect reftype for variable %s (got %s expected %s)", name_str, sv_reftype(restore, 0), sv_reftype(*orig, 0));
+              }
+            } else {
+              croak("The variable for %s is not a reference", name_str);
+            }
+          }
+        }
+      }
+    }
+
+
 
 void
 closed_over(cv)

Modified: trunk/libpadwalker-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/README?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/README (original)
+++ trunk/libpadwalker-perl/README Fri Jun 26 15:19:09 2009
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
-| PadWalker v1.7    - Robin Houston
+| PadWalker v1.8    - Robin Houston
 -----------------------------------------------------------------------------
 
 NAME
@@ -78,6 +78,13 @@
 	   does have reasonable uses: see Data::Dump::Streamer, for example (a
 	   future version of which may in fact use "closed_over").
 
+       set_closed_over SUB, HASH_REF
+	   "set_closed_over" reassigns the pad variables that are closed over
+	   by the subroutine.
+
+	   The second argument is a hash of references, much like the one
+	   returned from "closed_over".
+
        var_name LEVEL, VAR_REF
        var_name SUB,   VAR_REF
 	   "var_name(sub, var_ref)" returns the name of the variable referred
@@ -106,6 +113,6 @@
        Devel::LexAlias, Devel::Caller, Sub::Parameters
 
 COPYRIGHT
-       Copyright (c) 2000-2007, Robin Houston. All Rights Reserved.  This mod-
+       Copyright (c) 2000-2009, Robin Houston. All Rights Reserved.  This mod-
        ule is free software. It may be used, redistributed and/or modified
        under the same terms as Perl itself.

Modified: trunk/libpadwalker-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/debian/changelog?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/debian/changelog (original)
+++ trunk/libpadwalker-perl/debian/changelog Fri Jun 26 15:19:09 2009
@@ -1,8 +1,17 @@
-libpadwalker-perl (1.7-3) UNRELEASED; urgency=low
+libpadwalker-perl (1.9-1) UNRELEASED; urgency=low
 
+  * New upstream release
+    + New feature, set_closed_over
+  * Removed quilt stuff, since the patch is now applied upstream
+  * Standards version 3.8.2
+  * Added /me to copyright and uploaders
+  * Updated description (hopefully it's a bit more clear)
+  * Debhelper dependency back to 7, since quilt isn't used anymore
+
+  [ Nathan Handler ]
   * debian/watch: Update to ignore development releases.
 
- -- Nathan Handler <nhandler at ubuntu.com>  Sat, 06 Jun 2009 01:36:48 +0000
+ -- Jonathan Yu <frequency at cpan.org>  Fri, 26 Jun 2009 06:53:18 -0400
 
 libpadwalker-perl (1.7-2) unstable; urgency=low
 

Modified: trunk/libpadwalker-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/debian/control?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/debian/control (original)
+++ trunk/libpadwalker-perl/debian/control Fri Jun 26 15:19:09 2009
@@ -1,10 +1,11 @@
 Source: libpadwalker-perl
 Section: perl
 Priority: optional
-Build-Depends: debhelper (>= 7.0.50), quilt (>= 0.46-7)
+Build-Depends: debhelper (>= 7)
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Martín Ferrari <tincho at debian.org>, Ryan Niebur <ryanryan52 at gmail.com>
-Standards-Version: 3.8.1
+Uploaders: Ryan Niebur <ryanryan52 at gmail.com>, Jonathan Yu <frequency at cpan.org>,
+ Martín Ferrari <tincho at debian.org>
+Standards-Version: 3.8.2
 Homepage: http://search.cpan.org/dist/PadWalker/
 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libpadwalker-perl/
 Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libpadwalker-perl/
@@ -12,7 +13,15 @@
 Package: libpadwalker-perl
 Architecture: any
 Depends: ${perl:Depends}, ${shlibs:Depends}, ${misc:Depends}
-Description: module to inspect and manipulate lexical variables
- PadWalker is a module which allows you to inspect (and even change!)
- lexical variables in any subroutine which called you. It will only
- show those variables which are in scope at the point of the call.
+Description: Perl module to inspect and manipulate lexical variables
+ PadWalker is a module that allows you to inspect and even modify lexical
+ variables in the current "lexical pad stack." Perl tracks which variables
+ are accessible and visible in each lexical scope by keeping a separate
+ set of variables for each scope. This module looks for a given variable
+ by traversing that stack, which allows it to alter anything in the stack,
+ even variables not normally accessible in the current scope.
+ .
+ In practise, this module is useful for checking anything defined in the full
+ stack of subroutines that called your function, making it extremely useful
+ for debugging. It is, however, not recommended for use in production code.
+

Modified: trunk/libpadwalker-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/debian/copyright?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/debian/copyright (original)
+++ trunk/libpadwalker-perl/debian/copyright Fri Jun 26 15:19:09 2009
@@ -10,11 +10,12 @@
 License: Artistic | GPL-1+
 
 Files: debian/*
-Copyright: 2005, Chip Salzenberg <chip at debian.org>
- 2006, 2007, Florian Ragwitz <rafl at debian.org>
+Copyright: 2009, Jonathan Yu <frequency at cpan.org>
+ 2009, Ryan Niebur <ryanryan52 at gmail.com>
+ 2008, Niko Tyni <ntyni at debian.org>
  2008, Martín Ferrari <tincho at debian.org>
- 2008, Niko Tyni <ntyni at debian.org>
- 2009, Ryan Niebur <ryanryan52 at gmail.com>
+ 2006-2007, Florian Ragwitz <rafl at debian.org>
+ 2005, Chip Salzenberg <chip at debian.org>
 License: Artistic | GPL-1+
 
 License: Artistic

Modified: trunk/libpadwalker-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/debian/rules?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/debian/rules (original)
+++ trunk/libpadwalker-perl/debian/rules Fri Jun 26 15:19:09 2009
@@ -1,4 +1,4 @@
 #!/usr/bin/make -f
 
 %:
-	dh --with quilt $@
+	dh $@

Modified: trunk/libpadwalker-perl/t/closure.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libpadwalker-perl/t/closure.t?rev=38732&op=diff
==============================================================================
--- trunk/libpadwalker-perl/t/closure.t (original)
+++ trunk/libpadwalker-perl/t/closure.t Fri Jun 26 15:19:09 2009
@@ -1,7 +1,7 @@
 use strict; use warnings;
-use PadWalker 'closed_over';
+use PadWalker 'closed_over', 'set_closed_over';
 
-print "1..16\n";
+print "1..28\n";
 
 my $x=2;
 my $h = closed_over (my $sub = sub {my $y = $x++});
@@ -53,7 +53,48 @@
 bar();
 
 our $blah = 9;
+no warnings 'misc';
 my $blah = sub {$blah};
 my ($vars, $indices) = closed_over($blah);
 print (keys %$vars == 0 ? "ok 15\n" : "not ok 15\n");
 print (keys %$indices == 0 ? "ok 16\n" : "not ok 16\n");
+
+
+{
+    my $x     = 1;
+    my @foo   = ();
+    my $other = 5;
+    my $h     = closed_over( my $sub = sub { my $y = $x++; push @foo, $y; $y } );
+
+    my @keys = keys %$h;
+
+    print( @keys == 2 ? "ok 17\n" : "not ok 17\n" );
+    print( ${ $h->{'$x'} } eq 1 ? "ok 18\n" : "not ok 18\n" );
+
+    print( $sub->() == 1 ? "ok 19\n" : "not ok 19\n" );
+
+    set_closed_over( $sub, { '$x' => \$other } );
+
+    print( $sub->() == 5 ? "ok 20\n" : "not ok 20\n" );
+
+    print( $x == 2     ? "ok 21\n" : "not ok 21\n" );
+    print( $other == 6 ? "ok 22\n" : "not ok 22\n" );
+
+    print( @foo == 2 ? "ok 23\n" : "not ok 23\n" );
+
+    print( $foo[0] == 1 ? "ok 24\n" : "not ok 24\n" );
+
+    print( $foo[1] == 5 ? "ok 25\n" : "not ok 25\n" );
+
+    my @other;
+
+    set_closed_over( $sub, { '@foo' => \@other } );
+
+    print( $sub->() == 6 ? "ok 26\n" : "not ok 26\n" );
+
+    print( @other == 1 ? "ok 27\n" : "not ok 27\n" );
+
+    eval { set_closed_over( $sub, { '@foo' => \"foo" } ) };
+
+    print( $@ ? "ok 28\n" : "not ok 28\n" );
+}




More information about the Pkg-perl-cvs-commits mailing list