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.17 by root, Wed Jul 1 08:25:04 2009 UTC vs.
Revision 1.27 by root, Tue Jul 31 22:55:47 2018 UTC

… …
4 4
5#define PERL_VERSION_ATLEAST(a,b,c) \ 5#define PERL_VERSION_ATLEAST(a,b,c) \
6 (PERL_REVISION > (a) \ 6 (PERL_REVISION > (a) \
7 || (PERL_REVISION == (a) \ 7 || (PERL_REVISION == (a) \
8 && (PERL_VERSION > (b) \ 8 && (PERL_VERSION > (b) \
9 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c))))) 9 || (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))
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#if !PERL_VERSION_ATLEAST (5,10,0) 15#ifndef SvPAD_OUR
16# define SvPAD_OUR(dummy) 0 16# define SvPAD_OUR(dummy) 0
17#endif 17#endif
18 18
19/* pre-5.10 perls always succeed, with 5.10, we have to check first apparently */ 19/* pre-5.10 perls always succeed, with 5.10, we have to check first apparently */
20#ifndef GvNAME_HEK 20#ifndef GvNAME_HEK
21# define GvNAME_HEK(sv) 1 21# define GvNAME_HEK(sv) 1
22#endif
23
24#ifndef PadARRAY
25typedef AV PADNAMELIST;
26typedef SV PADNAME;
27# define PadnamePV(sv) SvPVX (sv)
28# define PadnameLEN(sv) SvCUR (sv)
29# define PadARRAY(pad) AvARRAY (pad)
30# define PadlistARRAY(pl) ((PAD **)AvARRAY (pl))
31#endif
32
33#ifndef PadMAX
34# define PadMAX(pad) AvFILLp (pad)
35#endif
36
37#ifndef padnamelist_fetch
38# define padnamelist_fetch(a,b) *av_fetch (a, b, FALSE)
39#endif
40
41#ifndef PadlistNAMES
42# define PadlistNAMES(padlist) *PadlistARRAY (padlist)
22#endif 43#endif
23 44
24#define res_pair(text) \ 45#define res_pair(text) \
25 do { \ 46 do { \
26 AV *av = newAV (); \ 47 AV *av = newAV (); \
… …
37 av_push (av, newSVpv (text, 0)); \ 58 av_push (av, newSVpv (text, 0)); \
38 av_push (about, newRV_noinc ((SV *)av)); \ 59 av_push (about, newRV_noinc ((SV *)av)); \
39 } while (0) 60 } while (0)
40 61
41#define res_gv(sigil) \ 62#define res_gv(sigil) \
42 res_text (form ("in the global %c%s::%.*s", sigil, \ 63 res_text (form ("the global %c%s::%.*s", sigil, \
43 HvNAME (GvSTASH (sv)), \ 64 HvNAME (GvSTASH (sv)), \
44 GvNAME_HEK (sv) ? GvNAMELEN (sv) : 11, \ 65 GvNAME_HEK (sv) ? GvNAMELEN (sv) : 11, \
45 GvNAME_HEK (sv) ? GvNAME (sv) : "<anonymous>")) 66 GvNAME_HEK (sv) ? GvNAME (sv) : "<anonymous>"))
46 67
47MODULE = Devel::FindRef PACKAGE = Devel::FindRef 68MODULE = Devel::FindRef PACKAGE = Devel::FindRef
… …
95 if ((rmagical = SvRMAGICAL (sv))) 116 if ((rmagical = SvRMAGICAL (sv)))
96 SvRMAGICAL_off (sv); 117 SvRMAGICAL_off (sv);
97 118
98 if (SvTYPE (sv) >= SVt_PVMG) 119 if (SvTYPE (sv) >= SVt_PVMG)
99 { 120 {
121#if !PERL_VERSION_ATLEAST (5,21,6)
100 if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv)) 122 if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))
101 { 123 {
102 /* I have no clue what this is */ 124 /* I have no clue what this is */
103 /* maybe some placeholder for our variables for eval? */ 125 /* maybe some placeholder for our variables for eval? */
104 /* it doesn't seem to reference anything, so we should be able to ignore it */ 126 /* it doesn't seem to reference anything, so we should be able to ignore it */
105 } 127 }
106 else 128 else
129#endif
130 if (SvMAGICAL (sv)) /* name-pads use SvMAGIC for other purposes */
107 { 131 {
108 MAGIC *mg = SvMAGIC (sv); 132 MAGIC *mg = SvMAGIC (sv);
109 133
110 while (mg) 134 while (mg)
111 { 135 {
… …
132 { 156 {
133 case SVt_PVAV: 157 case SVt_PVAV:
134 if (AvREAL (sv)) 158 if (AvREAL (sv))
135 for (i = AvFILLp (sv) + 1; i--; ) 159 for (i = AvFILLp (sv) + 1; i--; )
136 if (AvARRAY (sv)[i] == targ) 160 if (AvARRAY (sv)[i] == targ)
137 res_pair (form ("in array element %d of", i)); 161 res_pair (form ("the array element %d of", i));
138 162
139 break; 163 break;
140 164
141 case SVt_PVHV: 165 case SVt_PVHV:
142 if (hv_iterinit ((HV *)sv)) 166 if (hv_iterinit ((HV *)sv))
143 { 167 {
144 HE *he; 168 HE *he;
145 169
146 while ((he = hv_iternext ((HV *)sv))) 170 while ((he = hv_iternext ((HV *)sv)))
147 if (HeVAL (he) == targ) 171 if (HeVAL (he) == targ)
148 res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he))); 172 res_pair (form ("the hash member '%.*s' of", HeKLEN (he), HeKEY (he)));
149 } 173 }
150 174
151 break; 175 break;
152 176
153 case SVt_PVCV: 177 case SVt_PVCV:
154 { 178 {
155 int depth = CvDEPTH (sv); 179 PADLIST *padlist = CvISXSUB (cv) ? 0 : CvPADLIST (sv);
156 180
157 /* Anonymous subs have a padlist but zero depth */
158 if (CvANON (sv) && !depth && CvPADLIST (sv))
159 depth = 1;
160
161 if (depth) 181 if (padlist)
162 { 182 {
163 AV *padlist = CvPADLIST (sv); 183 int depth = CvDEPTH (sv);
184
185 /* Anonymous subs have a padlist but zero depth */
186 /* some hacks switch CvANON off, so we just blindly assume a minimum of 1 */
187 if (!depth && !PERL_VERSION_ATLEAST (5,21,6))
188 depth = 1;
164 189
165 while (depth) 190 while (depth)
166 { 191 {
167 AV *pad = (AV *)AvARRAY (padlist)[depth]; 192 PAD *pad = PadlistARRAY (padlist)[depth];
168 193
169 av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */ 194 av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
170 195
171 /* The 0th pad slot is @_ */ 196 /* The 0th pad slot is @_ */
172 if (AvARRAY (pad)[0] == targ) 197 if (PadARRAY (pad)[0] == targ)
173 res_pair ("the argument array for"); 198 res_pair ("the argument array for");
174 199
175 for (i = AvFILLp (pad) + 1; --i; ) 200 for (i = PadMAX (pad) + 1; --i; )
176 if (AvARRAY (pad)[i] == targ) 201 if (PadARRAY (pad)[i] == targ)
177 { 202 {
178 /* Values from constant functions are stored in the pad without any name */ 203 /* Values from constant functions are stored in the pad without any name */
179 SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i]; 204 PADNAME *name = padnamelist_fetch (PadlistNAMES (padlist), i);
180 205
181 if (name_sv && SvPOK (name_sv)) 206 if (name && PadnamePV (name) && *PadnamePV (name))
182 res_pair (form ("in the lexical '%s' in", SvPVX (name_sv))); 207 res_pair (form ("the lexical '%s' in", PadnamePV (name)));
183 else 208 else
184 res_pair ("in an unnamed lexical in"); 209 res_pair ("an unnamed lexical in");
185 } 210 }
186 211
187 --depth; 212 --depth;
188 } 213 }
189 } 214 }
… …
226 { 251 {
227 MAGIC *mg = mg_find (sv, PERL_MAGIC_defelem); 252 MAGIC *mg = mg_find (sv, PERL_MAGIC_defelem);
228 253
229 if (mg && mg->mg_obj) 254 if (mg && mg->mg_obj)
230 res_pair (form ("the target for the lvalue hash element '%.*s',", 255 res_pair (form ("the target for the lvalue hash element '%.*s',",
231 SvCUR (mg->mg_obj), SvPV_nolen (mg->mg_obj))); 256 (int)SvCUR (mg->mg_obj), SvPV_nolen (mg->mg_obj)));
232 else 257 else
233 res_pair (form ("the target for the lvalue array element #%d,", LvTARGOFF (sv))); 258 res_pair (form ("the target for the lvalue array element #%d,", LvTARGOFF (sv)));
234 } 259 }
235 else 260 else
236 res_pair (form ("an lvalue reference target (type '%c', ofs %d, len %d),", 261 res_pair (form ("an lvalue reference target (type '%c', ofs %d, len %d),",

Diff Legend

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