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.4 by root, Wed Feb 7 21:34:02 2007 UTC vs.
Revision 1.9 by root, Fri Jul 11 15:29:48 2008 UTC

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

Diff Legend

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