ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.xs
(Generate patch)

Comparing Devel-FindRef/FindRef.xs (file contents):
Revision 1.2 by root, Thu Jan 11 23:05:52 2007 UTC vs.
Revision 1.11 by root, Fri Jul 11 17:59:19 2008 UTC

1#include "EXTERN.h" 1#include "EXTERN.h"
2#include "perl.h" 2#include "perl.h"
3#include "XSUB.h" 3#include "XSUB.h"
4 4
5#define PERL_VERSION_ATLEAST(a,b,c) \
6 (PERL_REVISION > (a) \
7 || (PERL_REVISION == (a) \
8 && (PERL_VERSION > (b) \
9 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
10
11#if !PERL_VERSION_ATLEAST (5,8,9)
12# define SVt_LAST 16
13#endif
14
15#if !PERL_VERSION_ATLEAST (5,10,0)
16# define SvPAD_OUR(dummy) 0
17#endif
18
5#define res_pair(text) \ 19#define res_pair(text) \
6 { \ 20 do { \
7 AV *av = newAV (); \ 21 AV *av = newAV (); \
8 av_push (av, newSVpv (text, 0)); \ 22 av_push (av, newSVpv (text, 0)); \
23 if (rmagical) SvRMAGICAL_on (sv); \
9 av_push (av, newRV_inc (sv)); \ 24 av_push (av, sv_rvweaken (newRV_inc (sv))); \
25 if (rmagical) SvRMAGICAL_off (sv); \
10 av_push (about, newRV_noinc ((SV *)av)); \ 26 av_push (about, newRV_noinc ((SV *)av)); \
11 } 27 } while (0)
12 28
13#define res_gv(sigil) \ 29#define res_text(text) \
14 { \ 30 do { \
15 AV *av = newAV (); \ 31 AV *av = newAV (); \
16 av_push (av, newSVpv (form ("in the global %c%s::%.*s", sigil, \ 32 av_push (av, newSVpv (text, 0)); \
17 HvNAME (GvSTASH (sv)), \
18 GvNAMELEN (sv), GvNAME (sv) ? GvNAME (sv) : "<anonymous>"), \
19 0)); \
20 av_push (about, newRV_noinc ((SV *)av)); \ 33 av_push (about, newRV_noinc ((SV *)av)); \
21 } 34 } while (0)
35
36#define res_gv(sigil) \
37 res_text (form ("in the global %c%s::%.*s", sigil, \
38 HvNAME (GvSTASH (sv)), \
39 GvNAMELEN (sv), \
40 GvNAME (sv) ? GvNAME (sv) : "<anonymous>"))
22 41
23MODULE = Devel::FindRef PACKAGE = Devel::FindRef 42MODULE = Devel::FindRef PACKAGE = Devel::FindRef
24 43
25PROTOTYPES: ENABLE 44PROTOTYPES: ENABLE
26 45
… …
34void 53void
35find_ (SV *target) 54find_ (SV *target)
36 PPCODE: 55 PPCODE:
37{ 56{
38 SV *arena, *targ; 57 SV *arena, *targ;
39 int rmagical, i; 58 U32 rmagical;
59 int i;
40 AV *about = newAV (); 60 AV *about = newAV ();
41 AV *excl = newAV (); 61 AV *excl = newAV ();
42 62
43 if (!SvROK (target)) 63 if (!SvROK (target))
44 croak ("about expects a reference to a perl value"); 64 croak ("find expects a reference to a perl value");
45 65
46 targ = SvRV (target); 66 targ = SvRV (target);
47 67
48 for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena)) 68 for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena))
49 { 69 {
… …
62 if ((rmagical = SvRMAGICAL (sv))) 82 if ((rmagical = SvRMAGICAL (sv)))
63 SvRMAGICAL_off (sv); 83 SvRMAGICAL_off (sv);
64 84
65 if (SvTYPE (sv) >= SVt_PVMG) 85 if (SvTYPE (sv) >= SVt_PVMG)
66 { 86 {
67 MAGIC *mg = SvMAGIC (sv); 87 if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))
68 while (mg)
69 { 88 {
89 /* I have no clue what this is */
90 /* maybe some placeholder for our variables for eval? */
91 /* it doesn't seem to reference anything, so we should be able to ignore it */
92 }
93 else
94 {
95 MAGIC *mg = SvMAGIC (sv);
96
97 while (mg)
98 {
70 if (mg->mg_obj == targ) 99 if (mg->mg_obj == targ)
71 res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type)); 100 res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type));
101
72 if ((SV *)mg->mg_ptr == targ && mg->mg_flags & MGf_REFCOUNTED) 102 if ((SV *)mg->mg_ptr == targ && mg->mg_flags & MGf_REFCOUNTED)
73 res_pair (form ("referenced (in mg_ptr) by '%c' type magic attached to", mg->mg_type)); 103 res_pair (form ("referenced (in mg_ptr) by '%c' type magic attached to", mg->mg_type));
74 104
75 mg = mg->mg_moremagic; 105 mg = mg->mg_moremagic;
106 }
76 } 107 }
77 } 108 }
78 109
79 switch (SvTYPE (sv)) 110 if (SvROK (sv))
80 { 111 {
81 case SVt_RV:
82 if (sv != target && SvRV (sv) == targ) 112 if (sv != target && SvRV (sv) == targ && !SvWEAKREF (sv))
83 res_pair ("referenced by"); 113 res_pair ("referenced by");
114 }
115 else
116 switch (SvTYPE (sv))
84 break; 117 {
85
86 case SVt_PVAV: 118 case SVt_PVAV:
87 if (AvREAL (sv)) 119 if (AvREAL (sv))
88 for (i = AvFILLp (sv) + 1; i--; ) 120 for (i = AvFILLp (sv) + 1; i--; )
89 if (AvARRAY (sv)[i] == targ) 121 if (AvARRAY (sv)[i] == targ)
90 res_pair (form ("in array element %d of", i)); 122 res_pair (form ("in array element %d of", i));
123
91 break; 124 break;
92 125
93 case SVt_PVHV: 126 case SVt_PVHV:
94 if (hv_iterinit ((HV *)sv)) 127 if (hv_iterinit ((HV *)sv))
128 {
129 HE *he;
130
131 while ((he = hv_iternext ((HV *)sv)))
132 if (HeVAL (he) == targ)
133 res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he)));
134 }
135
136 break;
137
138 case SVt_PVCV:
95 { 139 {
140 int depth = CvDEPTH (sv);
141
142 /* Anonymous subs have a padlist but zero depth */
143 if (CvANON (sv) && !depth && CvPADLIST (sv))
144 depth = 1;
145
146 if (depth)
96 HE *he; 147 {
97 while ((he = hv_iternext ((HV *)sv))) 148 AV *padlist = CvPADLIST (sv);
149
150 while (depth)
151 {
152 AV *pad = (AV *)AvARRAY (padlist)[depth];
153
154 av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
155
156 for (i = AvFILLp (pad) + 1; i--; )
98 if (HeVAL (he) == targ) 157 if (AvARRAY (pad)[i] == targ)
99 res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he))); 158 {
159 /* Values from constant functions are stored in the pad without any name */
160 SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i];
161
162 if (name_sv && SvPOK (name_sv))
163 res_pair (form ("in the lexical '%s' in", SvPVX (name_sv)));
164 else
165 res_pair ("in an unnamed lexical in");
166 }
167
168 --depth;
169 }
170 }
171
172 if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ)
173 res_pair ("the constant value of");
174
175 if (!CvWEAKOUTSIDE (sv) && (SV*)CvOUTSIDE (sv) == targ)
176 res_pair ("the containing scope for");
177
178 if (sv == targ && CvANON (sv))
179 if (CvSTART (sv)
180 && CvSTART (sv)->op_type == OP_NEXTSTATE
181 && CopLINE ((COP *)CvSTART (sv)))
182 res_text (form ("the closure created at %s:%d",
183 CopFILE ((COP *)CvSTART (sv)) ? CopFILE ((COP *)CvSTART (sv)) : "<unknown>",
184 CopLINE ((COP *)CvSTART (sv))));
185 else
186 res_text (form ("the closure created somewhere in file %s (PLEASE REPORT!)",
187 CvFILE (sv) ? CvFILE (sv) : "<unknown>"));
100 } 188 }
189
101 break; 190 break;
102 191
103 case SVt_PVCV: 192 case SVt_PVGV:
104 {
105 int depth = CvDEPTH (sv);
106 if (depth) 193 if (GvGP (sv))
107 { 194 {
108 AV *padlist = CvPADLIST (sv); 195 if (GvSV (sv) == (SV *)targ) res_gv ('$');
109 while (depth) 196 if (GvAV (sv) == (AV *)targ) res_gv ('@');
110 { 197 if (GvHV (sv) == (HV *)targ) res_gv ('%');
111 AV *pad = (AV *)AvARRAY (padlist)[depth]; 198 if (GvCV (sv) == (CV *)targ) res_gv ('&');
112 av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads from being found */
113 for (i = AvFILLp (pad); i--; )
114 if (AvARRAY (pad)[i] == targ)
115 res_pair (form ("in the lexical '%s' in", SvPVX (AvARRAY (AvARRAY (padlist)[0])[i])));
116
117 --depth;
118 }
119 } 199 }
120 } 200
121 break; 201 break;
122
123 case SVt_PVGV:
124 if (GvGP (sv))
125 {
126 if (GvSV (sv) == targ)
127 res_gv ('$');
128 if (GvAV (sv) == (AV *)targ)
129 res_gv ('@');
130 if (GvHV (sv) == (HV *)targ)
131 res_gv ('%');
132 if (GvCV (sv) == (CV *)targ)
133 res_gv ('&');
134 }
135 break;
136 } 202 }
137 203
138 if (rmagical) 204 if (rmagical)
139 SvRMAGICAL_off (sv); 205 SvRMAGICAL_on (sv);
140 } 206 }
141 } 207 }
142 208
143 EXTEND (SP, 2); 209 EXTEND (SP, 2);
144 PUSHs (sv_2mortal (newRV_noinc ((SV *)about))); 210 PUSHs (sv_2mortal (newRV_noinc ((SV *)about)));

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines