r38847 - in /trunk/libdevel-findref-perl: Changes FindRef.pm FindRef.xs META.yml README debian/changelog debian/control debian/watch
nhandler-guest at users.alioth.debian.org
nhandler-guest at users.alioth.debian.org
Sun Jun 28 02:32:52 UTC 2009
Author: nhandler-guest
Date: Sun Jun 28 02:32:45 2009
New Revision: 38847
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38847
Log:
* New upstream release
* debian/watch:
- Update to ignore development releases.
- Remove comments
* debian/control:
- Add myself to list of Uploaders
- Bump Standards-Version to 3.8.2 (No changes)
Modified:
trunk/libdevel-findref-perl/Changes
trunk/libdevel-findref-perl/FindRef.pm
trunk/libdevel-findref-perl/FindRef.xs
trunk/libdevel-findref-perl/META.yml
trunk/libdevel-findref-perl/README
trunk/libdevel-findref-perl/debian/changelog
trunk/libdevel-findref-perl/debian/control
trunk/libdevel-findref-perl/debian/watch
Modified: trunk/libdevel-findref-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-findref-perl/Changes?rev=38847&op=diff
==============================================================================
--- trunk/libdevel-findref-perl/Changes (original)
+++ trunk/libdevel-findref-perl/Changes Sun Jun 28 02:32:45 2009
@@ -1,7 +1,15 @@
Revision history for Perl extension Devel::FindRef
TODO: unwrap the save stack to find mortalised scalars (too version dependent).
-TODO: get the stack non-running coroutine?
+TODO: hash keys containing \x00 do not display properly.
+TODO: get the stack of non-running coroutines?
+
+1.41 Fri Jun 26 16:48:49 CEST 2009
+ - special-case immortal values (\undef etc.)
+ - fix a bug causing some GV references to be dropped.
+ - find and output lvalue target references.
+ - escape hash keys on output.
+ - avoid a crash when passing in a non-reference.
1.4 Mon Dec 1 14:43:35 CET 2008
- show refcount for each scalar.
Modified: trunk/libdevel-findref-perl/FindRef.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-findref-perl/FindRef.pm?rev=38847&op=diff
==============================================================================
--- trunk/libdevel-findref-perl/FindRef.pm (original)
+++ trunk/libdevel-findref-perl/FindRef.pm Sun Jun 28 02:32:45 2009
@@ -7,7 +7,7 @@
use Scalar::Util;
BEGIN {
- our $VERSION = '1.4';
+ our $VERSION = '1.41';
XSLoader::load __PACKAGE__, $VERSION;
}
@@ -90,18 +90,18 @@
=over 4
-=item - in the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
+=item - the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
closure, which in turn is used quite a bit.
-=item - in the package-level lexical C<$global_my>.
-
-=item - in the global package variable named C<$Test::var>.
-
-=item - in the hash element C<ukukey2>, in the hash in the my variable
+=item - the package-level lexical C<$global_my>.
+
+=item - the global package variable named C<$Test::var>.
+
+=item - the hash element C<ukukey2>, in the hash in the my variable
C<$testsub_local> in the sub C<Test::testsub> and also in the hash
C<$referenced by Test::hash2>.
-=item - in the hash element with key C<ukukey> in the hash stored in
+=item - the hash element with key C<ukukey> in the hash stored in
C<%Test::hash>.
=item - some anonymous mortalised reference on the stack (which is caused
@@ -153,6 +153,7 @@
my (@about) = find $$refref;
if (@about) {
for my $about (@about) {
+ $about->[0] =~ s/([^\x20-\x7e])/sprintf "\\{%02x}", ord $1/ge;
$buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
if (@$about > 1) {
if ($seen{ref2ptr $about->[1]}++) {
@@ -174,6 +175,7 @@
};
$buf .= (_f $ref) . " is\n";
+
$track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
$buf
}
@@ -193,7 +195,7 @@
sub find($) {
my ($about, $excl) = &find_;
my %excl = map +($_ => undef), @$excl;
- grep !exists $excl{ref2ptr $_->[1]}, @$about
+ grep !($#$_ && exists $excl{ref2ptr $_->[1]}), @$about
}
=item $ref = Devel::FindRef::ptr2ref $integer
Modified: trunk/libdevel-findref-perl/FindRef.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-findref-perl/FindRef.xs?rev=38847&op=diff
==============================================================================
--- trunk/libdevel-findref-perl/FindRef.xs (original)
+++ trunk/libdevel-findref-perl/FindRef.xs Sun Jun 28 02:32:45 2009
@@ -58,158 +58,196 @@
targ = SvRV (target_ref);
- for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena))
+ if (SvIMMORTAL (targ))
{
- UV idx = SvREFCNT (arena);
-
- /* Remember that the zeroth slot is used as the pointer onwards, so don't
- include it. */
- while (--idx > 0)
+ if (targ == &PL_sv_undef)
+ res_text ("the immortal 'undef' value");
+ else if (targ == &PL_sv_yes)
+ res_text ("the immortal 'yes' value");
+ else if (targ == &PL_sv_no)
+ res_text ("the immortal 'no' value");
+ else if (targ == &PL_sv_placeholder)
+ res_text ("the immortal placeholder value");
+ else
+ res_text ("some unknown immortal");
+ }
+ else
+ {
+ for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena))
{
- SV *sv = &arena [idx];
-
- if (SvTYPE (sv) >= SVt_LAST)
- continue;
-
- /* temporarily disable RMAGICAL, it can easily interfere with us */
- if ((rmagical = SvRMAGICAL (sv)))
- SvRMAGICAL_off (sv);
-
- if (SvTYPE (sv) >= SVt_PVMG)
+ UV idx = SvREFCNT (arena);
+
+ /* Remember that the zeroth slot is used as the pointer onwards, so don't
+ include it. */
+ while (--idx > 0)
{
- if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))
+ SV *sv = &arena [idx];
+
+ if (SvTYPE (sv) >= SVt_LAST)
+ continue;
+
+ /* temporarily disable RMAGICAL, it can easily interfere with us */
+ if ((rmagical = SvRMAGICAL (sv)))
+ SvRMAGICAL_off (sv);
+
+ if (SvTYPE (sv) >= SVt_PVMG)
{
- /* I have no clue what this is */
- /* maybe some placeholder for our variables for eval? */
- /* it doesn't seem to reference anything, so we should be able to ignore it */
+ if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))
+ {
+ /* I have no clue what this is */
+ /* maybe some placeholder for our variables for eval? */
+ /* it doesn't seem to reference anything, so we should be able to ignore it */
+ }
+ else
+ {
+ MAGIC *mg = SvMAGIC (sv);
+
+ while (mg)
+ {
+ if (mg->mg_obj == targ && mg->mg_flags & MGf_REFCOUNTED)
+ res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type));
+
+ if ((SV *)mg->mg_ptr == targ)
+ res_pair (form ("%sreferenced (in mg_ptr) by '%c' type magic attached to",
+ mg->mg_len == HEf_SVKEY ? "" : "possibly ",
+ mg->mg_type));
+
+ mg = mg->mg_moremagic;
+ }
+ }
+ }
+
+ if (SvROK (sv))
+ {
+ if (SvRV (sv) == targ && !SvWEAKREF (sv) && sv != target_ref)
+ res_pair ("referenced by");
}
else
- {
- MAGIC *mg = SvMAGIC (sv);
-
- while (mg)
- {
- if (mg->mg_obj == targ)
- res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type));
-
- if ((SV *)mg->mg_ptr == targ && mg->mg_flags & MGf_REFCOUNTED)
- res_pair (form ("referenced (in mg_ptr) by '%c' type magic attached to", mg->mg_type));
-
- mg = mg->mg_moremagic;
- }
- }
+ switch (SvTYPE (sv))
+ {
+ case SVt_PVAV:
+ if (AvREAL (sv))
+ for (i = AvFILLp (sv) + 1; i--; )
+ if (AvARRAY (sv)[i] == targ)
+ res_pair (form ("in array element %d of", i));
+
+ break;
+
+ case SVt_PVHV:
+ if (hv_iterinit ((HV *)sv))
+ {
+ HE *he;
+
+ while ((he = hv_iternext ((HV *)sv)))
+ if (HeVAL (he) == targ)
+ res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he)));
+ }
+
+ break;
+
+ case SVt_PVCV:
+ {
+ int depth = CvDEPTH (sv);
+
+ /* Anonymous subs have a padlist but zero depth */
+ if (CvANON (sv) && !depth && CvPADLIST (sv))
+ depth = 1;
+
+ if (depth)
+ {
+ AV *padlist = CvPADLIST (sv);
+
+ while (depth)
+ {
+ AV *pad = (AV *)AvARRAY (padlist)[depth];
+
+ av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
+
+ /* The 0th pad slot is @_ */
+ if (AvARRAY (pad)[0] == targ)
+ res_pair ("the argument array for");
+
+ for (i = AvFILLp (pad) + 1; --i; )
+ if (AvARRAY (pad)[i] == targ)
+ {
+ /* Values from constant functions are stored in the pad without any name */
+ SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i];
+
+ if (name_sv && SvPOK (name_sv))
+ res_pair (form ("in the lexical '%s' in", SvPVX (name_sv)));
+ else
+ res_pair ("in an unnamed lexical in");
+ }
+
+ --depth;
+ }
+ }
+
+ if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ)
+ res_pair ("the constant value of");
+
+ if (!CvWEAKOUTSIDE (sv) && (SV*)CvOUTSIDE (sv) == targ)
+ res_pair ("the containing scope for");
+
+ if (sv == targ && CvANON (sv))
+ if (CvSTART (sv)
+ && CvSTART (sv)->op_type == OP_NEXTSTATE
+ && CopLINE ((COP *)CvSTART (sv)))
+ res_text (form ("the closure created at %s:%d",
+ CopFILE ((COP *)CvSTART (sv)) ? CopFILE ((COP *)CvSTART (sv)) : "<unknown>",
+ CopLINE ((COP *)CvSTART (sv))));
+ else
+ res_text (form ("the closure created somewhere in file %s (PLEASE REPORT!)",
+ CvFILE (sv) ? CvFILE (sv) : "<unknown>"));
+ }
+
+ break;
+
+ case SVt_PVGV:
+ if (GvGP (sv))
+ {
+ if (GvSV (sv) == (SV *)targ) res_gv ('$');
+ if (GvAV (sv) == (AV *)targ) res_gv ('@');
+ if (GvHV (sv) == (HV *)targ) res_gv ('%');
+ if (GvCV (sv) == (CV *)targ) res_gv ('&');
+ }
+
+ break;
+
+ case SVt_PVLV:
+ if (LvTARG (sv) == targ)
+ {
+ if (LvTYPE (sv) == 'y')
+ {
+ MAGIC *mg = mg_find (sv, PERL_MAGIC_defelem);
+
+ if (mg && mg->mg_obj)
+ res_pair (form ("the target for the lvalue hash element '%.*s',",
+ SvCUR (mg->mg_obj), SvPV_nolen (mg->mg_obj)));
+ else
+ res_pair (form ("the target for the lvalue array element #%d,", LvTARGOFF (sv)));
+ }
+ else
+ res_pair (form ("an lvalue reference target (type '%c', ofs %d, len %d),",
+ LvTYPE (sv), LvTARGOFF (sv), LvTARGLEN (sv)));
+ }
+
+ break;
+ }
+
+ if (rmagical)
+ SvRMAGICAL_on (sv);
}
-
- if (SvROK (sv))
- {
- if (SvRV (sv) == targ && !SvWEAKREF (sv) && sv != target_ref)
- res_pair ("referenced by");
- }
- else
- switch (SvTYPE (sv))
- {
- case SVt_PVAV:
- if (AvREAL (sv))
- for (i = AvFILLp (sv) + 1; i--; )
- if (AvARRAY (sv)[i] == targ)
- res_pair (form ("in array element %d of", i));
-
- break;
-
- case SVt_PVHV:
- if (hv_iterinit ((HV *)sv))
- {
- HE *he;
-
- while ((he = hv_iternext ((HV *)sv)))
- if (HeVAL (he) == targ)
- res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he)));
- }
-
- break;
-
- case SVt_PVCV:
- {
- int depth = CvDEPTH (sv);
-
- /* Anonymous subs have a padlist but zero depth */
- if (CvANON (sv) && !depth && CvPADLIST (sv))
- depth = 1;
-
- if (depth)
- {
- AV *padlist = CvPADLIST (sv);
-
- while (depth)
- {
- AV *pad = (AV *)AvARRAY (padlist)[depth];
-
- av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
-
- /* The 0th pad slot is @_ */
- if (AvARRAY (pad)[0] == targ)
- res_pair ("the argument array for");
-
- for (i = AvFILLp (pad) + 1; --i; )
- if (AvARRAY (pad)[i] == targ)
- {
- /* Values from constant functions are stored in the pad without any name */
- SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i];
-
- if (name_sv && SvPOK (name_sv))
- res_pair (form ("in the lexical '%s' in", SvPVX (name_sv)));
- else
- res_pair ("in an unnamed lexical in");
- }
-
- --depth;
- }
- }
-
- if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ)
- res_pair ("the constant value of");
-
- if (!CvWEAKOUTSIDE (sv) && (SV*)CvOUTSIDE (sv) == targ)
- res_pair ("the containing scope for");
-
- if (sv == targ && CvANON (sv))
- if (CvSTART (sv)
- && CvSTART (sv)->op_type == OP_NEXTSTATE
- && CopLINE ((COP *)CvSTART (sv)))
- res_text (form ("the closure created at %s:%d",
- CopFILE ((COP *)CvSTART (sv)) ? CopFILE ((COP *)CvSTART (sv)) : "<unknown>",
- CopLINE ((COP *)CvSTART (sv))));
- else
- res_text (form ("the closure created somewhere in file %s (PLEASE REPORT!)",
- CvFILE (sv) ? CvFILE (sv) : "<unknown>"));
- }
-
- break;
-
- case SVt_PVGV:
- if (GvGP (sv))
- {
- if (GvSV (sv) == (SV *)targ) res_gv ('$');
- if (GvAV (sv) == (AV *)targ) res_gv ('@');
- if (GvHV (sv) == (HV *)targ) res_gv ('%');
- if (GvCV (sv) == (CV *)targ) res_gv ('&');
- }
-
- break;
- }
-
- if (rmagical)
- SvRMAGICAL_on (sv);
}
+
+ /* look at the mortalise stack of the current coroutine */
+ for (i = 0; i <= PL_tmps_ix; ++i)
+ if (PL_tmps_stack [i] == targ)
+ res_text ("a temporary on the stack");
+
+ if (targ == (SV*)PL_main_cv)
+ res_text ("the main body of the program");
}
-
- /* look at the mortalise stack of the current coroutine */
- for (i = 0; i <= PL_tmps_ix; ++i)
- if (PL_tmps_stack [i] == targ)
- res_text ("a temporary on the stack");
-
- if (targ == (SV*)PL_main_cv)
- res_text ("the main body of the program");
EXTEND (SP, 2);
PUSHs (sv_2mortal (newRV_noinc ((SV *)about)));
@@ -226,6 +264,8 @@
UV
ref2ptr (SV *rv)
CODE:
+ if (!SvROK (rv))
+ croak ("argument to Devel::FindRef::ref2ptr must be a reference");
RETVAL = PTR2UV (SvRV (rv));
OUTPUT:
RETVAL
@@ -233,6 +273,8 @@
U32
_refcnt (SV *rv)
CODE:
+ if (!SvROK (rv))
+ croak ("argument to Devel::FindRef::_refcnt must be a reference");
RETVAL = SvREFCNT (SvRV (rv));
OUTPUT:
RETVAL
Modified: trunk/libdevel-findref-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-findref-perl/META.yml?rev=38847&op=diff
==============================================================================
--- trunk/libdevel-findref-perl/META.yml (original)
+++ trunk/libdevel-findref-perl/META.yml Sun Jun 28 02:32:45 2009
@@ -1,12 +1,20 @@
--- #YAML:1.0
-name: Devel-FindRef
-version: 1.4
-abstract: ~
-license: ~
-author: ~
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
+name: Devel-FindRef
+version: 1.41
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires: {}
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.50
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: trunk/libdevel-findref-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-findref-perl/README?rev=38847&op=diff
==============================================================================
--- trunk/libdevel-findref-perl/README (original)
+++ trunk/libdevel-findref-perl/README Sun Jun 28 02:32:45 2009
@@ -21,13 +21,13 @@
use Devel::FindRef;
use Scalar::Util;
-
- our $var = "hi\n";
+
+ our $var = "hi\n";
my $global_my = \$var;
our %global_hash = (ukukey => \$var);
our $global_hashref = { ukukey2 => \$var };
-
- sub testsub {
+
+ sub testsub {
my $testsub_local = $global_hashref;
print Devel::FindRef::track \$var;
}
@@ -72,15 +72,14 @@
It is a bit convoluted to read, but basically it says that the value
stored in $var is referenced by:
- - in the lexical $closure_var (0x8abcc8), which is inside an
- instantiated closure, which in turn is used quite a bit.
- - in the package-level lexical $global_my.
- - in the global package variable named $Test::var.
- - in the hash element "ukukey2", in the hash in the my variable
+ - the lexical $closure_var (0x8abcc8), which is inside an instantiated
+ closure, which in turn is used quite a bit.
+ - the package-level lexical $global_my.
+ - the global package variable named $Test::var.
+ - the hash element "ukukey2", in the hash in the my variable
$testsub_local in the sub "Test::testsub" and also in the hash
"$referenced by Test::hash2".
- - in the hash element with key "ukukey" in the hash stored in
- %Test::hash.
+ - the hash element with key "ukukey" in the hash stored in %Test::hash.
- some anonymous mortalised reference on the stack (which is caused by
calling "track" with the expression "\$var", which creates the
reference).
Modified: trunk/libdevel-findref-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-findref-perl/debian/changelog?rev=38847&op=diff
==============================================================================
--- trunk/libdevel-findref-perl/debian/changelog (original)
+++ trunk/libdevel-findref-perl/debian/changelog Sun Jun 28 02:32:45 2009
@@ -1,8 +1,14 @@
-libdevel-findref-perl (1.4-2) UNRELEASED; urgency=low
+libdevel-findref-perl (1.41-1) unstable; urgency=low
- * debian/watch: Update to ignore development releases.
+ * New upstream release
+ * debian/watch:
+ - Update to ignore development releases.
+ - Remove comments
+ * debian/control:
+ - Add myself to list of Uploaders
+ - Bump Standards-Version to 3.8.2 (No changes)
- -- Nathan Handler <nhandler at ubuntu.com> Sat, 06 Jun 2009 01:33:50 +0000
+ -- Nathan Handler <nhandler at ubuntu.com> Sun, 28 Jun 2009 02:31:01 +0000
libdevel-findref-perl (1.4-1) unstable; urgency=low
Modified: trunk/libdevel-findref-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-findref-perl/debian/control?rev=38847&op=diff
==============================================================================
--- trunk/libdevel-findref-perl/debian/control (original)
+++ trunk/libdevel-findref-perl/debian/control Sun Jun 28 02:32:45 2009
@@ -3,8 +3,9 @@
Priority: optional
Build-Depends: debhelper (>= 7), perl (>= 5.6.0-12)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Jonathan Yu <frequency at cpan.org>
-Standards-Version: 3.8.1
+Uploaders: Jonathan Yu <frequency at cpan.org>,
+ Nathan Handler <nhandler at ubuntu.com>
+Standards-Version: 3.8.2
Homepage: http://search.cpan.org/dist/Devel-FindRef/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libdevel-findref-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libdevel-findref-perl/
Modified: trunk/libdevel-findref-perl/debian/watch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-findref-perl/debian/watch?rev=38847&op=diff
==============================================================================
--- trunk/libdevel-findref-perl/debian/watch (original)
+++ trunk/libdevel-findref-perl/debian/watch Sun Jun 28 02:32:45 2009
@@ -1,4 +1,2 @@
-# format version number, currently 3; this line is compulsory!
version=3
-# URL to the package page followed by a regex to search
http://search.cpan.org/dist/Devel-FindRef/ .*/Devel-FindRef-v?(\d[\d.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$
More information about the Pkg-perl-cvs-commits
mailing list