| … | |
… | |
| 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 |
22 | #endif |
| 23 | |
23 | |
| 24 | #ifndef PadARRAY |
24 | #ifndef PadARRAY |
|
|
25 | typedef AV PADNAMELIST; |
|
|
26 | typedef SV PADNAME; |
|
|
27 | # define PadnamePV(sv) SvPVX (sv) |
|
|
28 | # define PadnameLEN(sv) SvCUR (sv) |
| 25 | # define PadARRAY(pad) AvARRAY (pad) |
29 | # define PadARRAY(pad) AvARRAY (pad) |
| 26 | # define PadlistARRAY(pl) ((PAD **)AvARRAY (pl)) |
30 | # define PadlistARRAY(pl) ((PAD **)AvARRAY (pl)) |
| 27 | #endif |
31 | #endif |
| 28 | |
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) |
|
|
43 | #endif |
| 29 | |
44 | |
| 30 | #define res_pair(text) \ |
45 | #define res_pair(text) \ |
| 31 | do { \ |
46 | do { \ |
| 32 | AV *av = newAV (); \ |
47 | AV *av = newAV (); \ |
| 33 | av_push (av, newSVpv (text, 0)); \ |
48 | av_push (av, newSVpv (text, 0)); \ |
| … | |
… | |
| 101 | if ((rmagical = SvRMAGICAL (sv))) |
116 | if ((rmagical = SvRMAGICAL (sv))) |
| 102 | SvRMAGICAL_off (sv); |
117 | SvRMAGICAL_off (sv); |
| 103 | |
118 | |
| 104 | if (SvTYPE (sv) >= SVt_PVMG) |
119 | if (SvTYPE (sv) >= SVt_PVMG) |
| 105 | { |
120 | { |
|
|
121 | #if !PERL_VERSION_ATLEAST (5,21,6) |
| 106 | if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv)) |
122 | if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv)) |
| 107 | { |
123 | { |
| 108 | /* I have no clue what this is */ |
124 | /* I have no clue what this is */ |
| 109 | /* maybe some placeholder for our variables for eval? */ |
125 | /* maybe some placeholder for our variables for eval? */ |
| 110 | /* 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 */ |
| 111 | } |
127 | } |
|
|
128 | else |
|
|
129 | #endif |
| 112 | else if (SvMAGICAL (sv)) /* name-pads use SvMAGIC for other purposes */ |
130 | if (SvMAGICAL (sv)) /* name-pads use SvMAGIC for other purposes */ |
| 113 | { |
131 | { |
| 114 | MAGIC *mg = SvMAGIC (sv); |
132 | MAGIC *mg = SvMAGIC (sv); |
| 115 | |
133 | |
| 116 | while (mg) |
134 | while (mg) |
| 117 | { |
135 | { |
| … | |
… | |
| 164 | { |
182 | { |
| 165 | int depth = CvDEPTH (sv); |
183 | int depth = CvDEPTH (sv); |
| 166 | |
184 | |
| 167 | /* Anonymous subs have a padlist but zero depth */ |
185 | /* Anonymous subs have a padlist but zero depth */ |
| 168 | /* some hacks switch CvANON off, so we just blindly assume a minimum of 1 */ |
186 | /* some hacks switch CvANON off, so we just blindly assume a minimum of 1 */ |
| 169 | if (!depth) |
187 | if (!depth && !PERL_VERSION_ATLEAST (5,21,6)) |
| 170 | depth = 1; |
188 | depth = 1; |
| 171 | |
189 | |
| 172 | while (depth) |
190 | while (depth) |
| 173 | { |
191 | { |
| 174 | PAD *pad = PadlistARRAY (padlist)[depth]; |
192 | PAD *pad = PadlistARRAY (padlist)[depth]; |
| … | |
… | |
| 177 | |
195 | |
| 178 | /* The 0th pad slot is @_ */ |
196 | /* The 0th pad slot is @_ */ |
| 179 | if (PadARRAY (pad)[0] == targ) |
197 | if (PadARRAY (pad)[0] == targ) |
| 180 | res_pair ("the argument array for"); |
198 | res_pair ("the argument array for"); |
| 181 | |
199 | |
| 182 | for (i = AvFILLp (pad) + 1; --i; ) |
200 | for (i = PadMAX (pad) + 1; --i; ) |
| 183 | if (AvARRAY (pad)[i] == targ) |
201 | if (PadARRAY (pad)[i] == targ) |
| 184 | { |
202 | { |
| 185 | /* 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 */ |
| 186 | SV *name_sv = PadARRAY (PadlistARRAY (padlist)[0])[i]; |
204 | PADNAME *name = padnamelist_fetch (PadlistNAMES (padlist), i); |
| 187 | |
205 | |
| 188 | if (name_sv && SvPOK (name_sv)) |
206 | if (name && PadnamePV (name) && *PadnamePV (name)) |
| 189 | res_pair (form ("the lexical '%s' in", SvPVX (name_sv))); |
207 | res_pair (form ("the lexical '%s' in", PadnamePV (name))); |
| 190 | else |
208 | else |
| 191 | res_pair ("an unnamed lexical in"); |
209 | res_pair ("an unnamed lexical in"); |
| 192 | } |
210 | } |
| 193 | |
211 | |
| 194 | --depth; |
212 | --depth; |
