--- Devel-FindRef/FindRef.xs 2008/12/01 13:47:09 1.15 +++ Devel-FindRef/FindRef.xs 2009/06/26 14:47:03 1.16 @@ -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); + UV idx = SvREFCNT (arena); - if (SvTYPE (sv) >= SVt_PVMG) + /* 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)) - { - /* 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); + SV *sv = &arena [idx]; - while (mg) - { - if (mg->mg_obj == targ) - res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type)); + if (SvTYPE (sv) >= SVt_LAST) + continue; - 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)); + /* temporarily disable RMAGICAL, it can easily interfere with us */ + if ((rmagical = SvRMAGICAL (sv))) + SvRMAGICAL_off (sv); - mg = mg->mg_moremagic; + 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 */ } - } - } - - 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)) + else { - HE *he; + MAGIC *mg = SvMAGIC (sv); - while ((he = hv_iternext ((HV *)sv))) - if (HeVAL (he) == targ) - res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he))); - } + 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)); - break; + mg = mg->mg_moremagic; + } + } + } - case SVt_PVCV: + if (SvROK (sv)) + { + if (SvRV (sv) == targ && !SvWEAKREF (sv) && sv != target_ref) + res_pair ("referenced by"); + } + else + switch (SvTYPE (sv)) { - int depth = CvDEPTH (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))); + } - /* Anonymous subs have a padlist but zero depth */ - if (CvANON (sv) && !depth && CvPADLIST (sv)) - depth = 1; + break; - if (depth) + case SVt_PVCV: { - AV *padlist = CvPADLIST (sv); + int depth = CvDEPTH (sv); - while (depth) - { - AV *pad = (AV *)AvARRAY (padlist)[depth]; + /* Anonymous subs have a padlist but zero depth */ + if (CvANON (sv) && !depth && CvPADLIST (sv)) + depth = 1; - av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */ + if (depth) + { + AV *padlist = CvPADLIST (sv); - /* 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"); - } + 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; + --depth; + } } - } - if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ) - res_pair ("the constant value of"); + 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 (!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) : "")); - } + 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; + 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 ('&'); - } + 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; - } + break; + } - if (rmagical) - SvRMAGICAL_on (sv); + 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"); + /* 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"); + 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