Devel-FindRef-1.422/0000755000000000000000000000000011246506767012610 5ustar rootrootDevel-FindRef-1.422/Changes0000644000000000000000000000460311246506735014101 0ustar rootrootRevision history for Perl extension Devel::FindRef TODO: unwrap the save stack to find mortalised scalars (too version dependent). TODO: hash keys containing \x00 do not display properly. TODO: get the stack of non-running coroutines? 1.422 Sun Aug 30 16:33:24 CEST 2009 - more of the same changes as in 1.422. - rely on common::sense. 1.421 Fri Aug 28 22:25:57 CEST 2009 - tweaked lexical messages a bit (the HASH "is the lexical %var", not "is in the lexical %var". 1.42 Wed Jul 1 10:24:42 CEST 2009 - allow possible anonymous gv's without crashing in 5.10 (untested). 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. - indicate that scalars are mortalised (but not where). - flatten the results slightly. 1.31 Sun Jul 20 18:38:17 CEST 2008 - correctly identify the main program and function call argument vectors (patch by Paul LeoNerd Evans). - use ref2ptr instead of +0 to correctly get the address of overloaded variables (reported by Paul LeoNerd Evans). - use UV in ptr2ref, as perl seems to do the same internally. 1.3 Sat Jul 12 00:17:03 CEST 2008 - ignore the new "our" PVMG sv's from perl 5.10. - apply a lot of fixes by Chris Heath, handling constant functions and WEAKOUTSIDE better. - avoid following circular reference chains. - add some visual clues to the output string. - look into anonymous closures to see where they were cloned. - introduce PERL_DEVEL_FINDREF_DEPTH env variable. 1.2 Sat Apr 26 05:14:58 CEST 2008 - apply lots of fixes by Chris Heath. - redo example in manpage, it's complete now. 1.1 Sat Dec 29 22:04:14 CET 2007 - ignore weak references. - weaken internal references, to avoid displaying them and drowning important output. - properly find magical references. 1.0 Wed Nov 28 13:19:45 CET 2007 - correctly restore RMAGICAL flag (Ruslan Zakirov). 0.2 Wed Feb 7 22:31:58 CET 2007 - "backport" to 5.8.8. 0.1 Fri Jan 12 00:06:57 CET 2007 - initial release. 0.0 Thu Jan 11 14:21:47 CET 2007 - copied from Convert-Scalar. Devel-FindRef-1.422/COPYING0000644000000000000000000000036610551527766013650 0ustar rootroot Copyright (C) 2007 by Marc Lehmann. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. Devel-FindRef-1.422/MANIFEST0000644000000000000000000000023511246506767013741 0ustar rootrootCOPYING Changes Makefile.PL MANIFEST README FindRef.xs FindRef.pm t/00_load.t META.yml Module meta-data (added by MakeMaker) Devel-FindRef-1.422/FindRef.xs0000644000000000000000000002541211246506635014477 0ustar rootroot#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #define PERL_VERSION_ATLEAST(a,b,c) \ (PERL_REVISION > (a) \ || (PERL_REVISION == (a) \ && (PERL_VERSION > (b) \ || (PERL_VERSION == (b) && PERLSUBVERSION >= (c))))) #if !PERL_VERSION_ATLEAST (5,8,9) # define SVt_LAST 16 #endif #if !PERL_VERSION_ATLEAST (5,10,0) # define SvPAD_OUR(dummy) 0 #endif /* pre-5.10 perls always succeed, with 5.10, we have to check first apparently */ #ifndef GvNAME_HEK # define GvNAME_HEK(sv) 1 #endif #define res_pair(text) \ do { \ AV *av = newAV (); \ av_push (av, newSVpv (text, 0)); \ if (rmagical) SvRMAGICAL_on (sv); \ av_push (av, sv_rvweaken (newRV_inc (sv))); \ if (rmagical) SvRMAGICAL_off (sv); \ av_push (about, newRV_noinc ((SV *)av)); \ } while (0) #define res_text(text) \ do { \ AV *av = newAV (); \ av_push (av, newSVpv (text, 0)); \ av_push (about, newRV_noinc ((SV *)av)); \ } while (0) #define res_gv(sigil) \ res_text (form ("the global %c%s::%.*s", sigil, \ HvNAME (GvSTASH (sv)), \ GvNAME_HEK (sv) ? GvNAMELEN (sv) : 11, \ GvNAME_HEK (sv) ? GvNAME (sv) : "")) MODULE = Devel::FindRef PACKAGE = Devel::FindRef PROTOTYPES: ENABLE void find_ (SV *target_ref) PPCODE: { SV *arena, *targ; U32 rmagical; int i; AV *about = newAV (); AV *excl = newAV (); if (!SvROK (target_ref)) croak ("find expects a reference to a perl value"); targ = SvRV (target_ref); if (SvIMMORTAL (targ)) { 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)) { UV idx = SvREFCNT (arena); /* Remember that the zeroth slot is used as the pointer onwards, so don't include it. */ while (--idx > 0) { 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) { 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 switch (SvTYPE (sv)) { case SVt_PVAV: if (AvREAL (sv)) for (i = AvFILLp (sv) + 1; i--; ) if (AvARRAY (sv)[i] == targ) res_pair (form ("the 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 ("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 ("the lexical '%s' in", SvPVX (name_sv))); else res_pair ("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)) : "", CopLINE ((COP *)CvSTART (sv)))); else res_text (form ("the closure created somewhere in file %s (PLEASE REPORT!)", CvFILE (sv) ? CvFILE (sv) : "")); } 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); } } /* 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))); PUSHs (sv_2mortal (newRV_noinc ((SV *)excl))); } SV * ptr2ref (UV ptr) CODE: RETVAL = newRV_inc (INT2PTR (SV *, ptr)); OUTPUT: RETVAL UV ref2ptr (SV *rv) CODE: if (!SvROK (rv)) croak ("argument to Devel::FindRef::ref2ptr must be a reference"); RETVAL = PTR2UV (SvRV (rv)); OUTPUT: RETVAL U32 _refcnt (SV *rv) CODE: if (!SvROK (rv)) croak ("argument to Devel::FindRef::_refcnt must be a reference"); RETVAL = SvREFCNT (SvRV (rv)); OUTPUT: RETVAL Devel-FindRef-1.422/t/0000755000000000000000000000000011246506767013053 5ustar rootrootDevel-FindRef-1.422/t/00_load.t0000644000000000000000000000017410551527173014450 0ustar rootrootBEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use Devel::FindRef; $loaded = 1; print "ok 1\n"; Devel-FindRef-1.422/FindRef.pm0000644000000000000000000001602111246506755014460 0ustar rootrootpackage Devel::FindRef; use common::sense; use XSLoader; use Scalar::Util; BEGIN { our $VERSION = '1.422'; XSLoader::load __PACKAGE__, $VERSION; } =head1 NAME Devel::FindRef - where is that reference to my variable hiding? =head1 SYNOPSIS use Devel::FindRef; print Devel::FindRef::track \$some_variable; =head1 DESCRIPTION Tracking down reference problems (e.g. you expect some object to be destroyed, but there are still references to it that keep it alive) can be very hard. Fortunately, perl keeps track of all its values, so tracking references "backwards" is usually possible. The C function can help track down some of those references back to the variables containing them. For example, for this fragment: package Test; use Devel::FindRef; use Scalar::Util; our $var = "hi\n"; my $global_my = \$var; our %global_hash = (ukukey => \$var); our $global_hashref = { ukukey2 => \$var }; sub testsub { my $testsub_local = $global_hashref; print Devel::FindRef::track \$var; } my $closure = sub { my $closure_var = \$_[0]; Scalar::Util::weaken (my $weak_ref = \$var); testsub; }; $closure->($var); The output is as follows (or similar to this, in case I forget to update the manpage after some changes): SCALAR(0x7cc888) [refcount 6] is +- referenced by REF(0x8abcc8) [refcount 1], which is | in the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is | +- the closure created at tst:18. | +- referenced by REF(0x7d3c58) [refcount 1], which is | | in the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is | | +- the containing scope for CODE(0x8ab430) [refcount 3], which is | | | in the global &Test::testsub. | | +- the main body of the program. | +- in the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before. +- referenced by REF(0x7cc7c8) [refcount 1], which is | in the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before. +- in the global $Test::var. +- referenced by REF(0x7cc558) [refcount 1], which is | in the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is | +- referenced by REF(0x8abad0) [refcount 1], which is | | in the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before. | +- referenced by REF(0x8ab4f0) [refcount 1], which is | in the global $Test::global_hashref. +- referenced by REF(0x7ae518) [refcount 1], which is | in the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is | in the global %Test::global_hash. +- referenced by REF(0x7ae2f0) [refcount 1], which is a temporary on the stack. It is a bit convoluted to read, but basically it says that the value stored in C<$var> is referenced by: =over 4 =item - the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated closure, which in turn is used quite a bit. =item - the package-level lexical C<$global_my>. =item - the global package variable named C<$Test::var>. =item - the hash element C, in the hash in the my variable C<$testsub_local> in the sub C and also in the hash C<$referenced by Test::hash2>. =item - the hash element with key C in the hash stored in C<%Test::hash>. =item - some anonymous mortalised reference on the stack (which is caused by calling C with the expression C<\$var>, which creates the reference). =back And all these account for six reference counts. =head1 EXPORTS None. =head1 FUNCTIONS =over 4 =item $string = Devel::FindRef::track $ref[, $depth] Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and return a descriptive string. C<$ref> can point at any perl value, be it anonymous sub, hash, array, scalar etc. This is the function you most often use. =cut sub find($); sub _f($) { "$_[0] [refcount " . (_refcnt $_[0]) . "]" } sub track { my ($ref, $depth) = @_; @_ = (); my $buf = ""; my %seen; Scalar::Util::weaken $ref; my $track; $track = sub { my ($refref, $depth, $indent) = @_; if ($depth) { 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]}++) { $buf .= " " . (_f $about->[1]) . ", which was seen before.\n"; } else { $buf .= " " . (_f $about->[1]) . ", which is\n"; $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| "); } } else { $buf .= ".\n"; } } } else { $buf .= "$indent not found anywhere I looked :(\n"; } } else { $buf .= "$indent not referenced within the search depth.\n"; } }; $buf .= (_f $ref) . " is\n"; $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, ""); $buf } =item @references = Devel::FindRef::find $ref Return arrayrefs that contain [$message, $ref] pairs. The message describes what kind of reference was found and the C<$ref> is the reference itself, which can be omitted if C decided to end the search. The returned references are all weak references. The C function uses this to find references to the value you are interested in and recurses on the returned references. =cut sub find($) { my ($about, $excl) = &find_; my %excl = map +($_ => undef), @$excl; grep !($#$_ && exists $excl{ref2ptr $_->[1]}), @$about } =item $ref = Devel::FindRef::ptr2ref $integer Sometimes you know (from debugging output) the address of a perl scalar you are interested in (e.g. C). This function can be used to turn the address into a reference to that scalar. It is quite safe to call on valid addresses, but extremely dangerous to call on invalid ones. # we know that HASH(0x176ff70) exists, so turn it into a hashref: my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70; =item $ref = Devel::FindRef::ref2ptr $reference The opposite of C, above: returns the internal address of the value pointed to by the passed reference. I, so don't use this. =back =head1 ENVIRONMENT VARIABLES You can set the environment variable C to an integer to override the default depth in C. If a call explicitly specified a depth it is not overridden. =head1 AUTHOR Marc Lehmann . =head1 COPYRIGHT AND LICENSE Copyright (C) 2007, 2008 by Marc Lehmann. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut 1 Devel-FindRef-1.422/Makefile.PL0000644000000000000000000000060011246506722014545 0ustar rootrootuse ExtUtils::MakeMaker; use 5.008001; WriteMakefile( dist => { PREOP => 'pod2text FindRef.pm | tee README >$(DISTVNAME)/README; chmod -R u=rwX,go=rX . ;', COMPRESS => 'gzip -9v', SUFFIX => '.gz', }, PREREQ_PM => { common::sense => 0, }, NAME => "Devel::FindRef", VERSION_FROM => "FindRef.pm", ); Devel-FindRef-1.422/README0000644000000000000000000001324411246506767013474 0ustar rootrootNAME Devel::FindRef - where is that reference to my variable hiding? SYNOPSIS use Devel::FindRef; print Devel::FindRef::track \$some_variable; DESCRIPTION Tracking down reference problems (e.g. you expect some object to be destroyed, but there are still references to it that keep it alive) can be very hard. Fortunately, perl keeps track of all its values, so tracking references "backwards" is usually possible. The "track" function can help track down some of those references back to the variables containing them. For example, for this fragment: package Test; use Devel::FindRef; use Scalar::Util; our $var = "hi\n"; my $global_my = \$var; our %global_hash = (ukukey => \$var); our $global_hashref = { ukukey2 => \$var }; sub testsub { my $testsub_local = $global_hashref; print Devel::FindRef::track \$var; } my $closure = sub { my $closure_var = \$_[0]; Scalar::Util::weaken (my $weak_ref = \$var); testsub; }; $closure->($var); The output is as follows (or similar to this, in case I forget to update the manpage after some changes): SCALAR(0x7cc888) [refcount 6] is +- referenced by REF(0x8abcc8) [refcount 1], which is | in the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is | +- the closure created at tst:18. | +- referenced by REF(0x7d3c58) [refcount 1], which is | | in the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is | | +- the containing scope for CODE(0x8ab430) [refcount 3], which is | | | in the global &Test::testsub. | | +- the main body of the program. | +- in the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before. +- referenced by REF(0x7cc7c8) [refcount 1], which is | in the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before. +- in the global $Test::var. +- referenced by REF(0x7cc558) [refcount 1], which is | in the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is | +- referenced by REF(0x8abad0) [refcount 1], which is | | in the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before. | +- referenced by REF(0x8ab4f0) [refcount 1], which is | in the global $Test::global_hashref. +- referenced by REF(0x7ae518) [refcount 1], which is | in the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is | in the global %Test::global_hash. +- referenced by REF(0x7ae2f0) [refcount 1], which is a temporary on the stack. It is a bit convoluted to read, but basically it says that the value stored in $var is referenced by: - 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". - 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). And all these account for six reference counts. EXPORTS None. FUNCTIONS $string = Devel::FindRef::track $ref[, $depth] Track the perl value pointed to by $ref up to a depth of $depth and return a descriptive string. $ref can point at any perl value, be it anonymous sub, hash, array, scalar etc. This is the function you most often use. @references = Devel::FindRef::find $ref Return arrayrefs that contain [$message, $ref] pairs. The message describes what kind of reference was found and the $ref is the reference itself, which can be omitted if "find" decided to end the search. The returned references are all weak references. The "track" function uses this to find references to the value you are interested in and recurses on the returned references. $ref = Devel::FindRef::ptr2ref $integer Sometimes you know (from debugging output) the address of a perl scalar you are interested in (e.g. "HASH(0x176ff70)"). This function can be used to turn the address into a reference to that scalar. It is quite safe to call on valid addresses, but extremely dangerous to call on invalid ones. # we know that HASH(0x176ff70) exists, so turn it into a hashref: my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70; $ref = Devel::FindRef::ref2ptr $reference The opposite of "ptr2ref", above: returns the internal address of the value pointed to by the passed reference. *No checks whatsoever will be done*, so don't use this. ENVIRONMENT VARIABLES You can set the environment variable "PERL_DEVEL_FINDREF_DEPTH" to an integer to override the default depth in "track". If a call explicitly specified a depth it is not overridden. AUTHOR Marc Lehmann . COPYRIGHT AND LICENSE Copyright (C) 2007, 2008 by Marc Lehmann. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. Devel-FindRef-1.422/META.yml0000644000000000000000000000112211246506767014055 0ustar rootroot{ "no_index" : { "directory" : [ "t", "inc" ] }, "meta-spec" : { "version" : 1.4, "url" : "http://module-build.sourceforge.net/META-spec-v1.4.html" }, "generated_by" : "ExtUtils::MakeMaker version 6.50", "distribution_type" : "module", "version" : "1.422", "name" : "Devel-FindRef", "author" : [], "license" : "unknown", "build_requires" : { "ExtUtils::MakeMaker" : 0 }, "requires" : { "common::sense" : 0 }, "abstract" : null, "configure_requires" : { "ExtUtils::MakeMaker" : 0 } }