The patch was feeling a bit detached.
diff -rup Parse-Perl-0.007-pfy2I5/lib/Parse/Perl.xs Parse-Perl-0.007-0wiWOF/lib/Parse/Perl.xs
--- Parse-Perl-0.007-pfy2I5/lib/Parse/Perl.xs 2012-02-05 14:23:46.000000000 -0800
+++ Parse-Perl-0.007-0wiWOF/lib/Parse/Perl.xs 2012-08-23 00:34:36.000000000 -0700
@@ -61,6 +61,29 @@
# endif /* <5.11.2 */
#endif /* !pad_findmy_sv */
+#ifndef PadARRAY
+typedef AV PADNAMELIST;
+typedef SV PADNAME;
+# if PERL_VERSION < 9
+typedef AV PADLIST;
+typedef AV PAD;
+# endif
+# define PadlistARRAY(pl) ((PAD **)AvARRAY(pl))
+# define PadlistNAMES(pl) (*PadlistARRAY(pl))
+# define PadnamelistARRAY(pnl) ((PADNAME **)AvARRAY(pnl))
+# define PadnamelistMAX(pnl) AvFILLp(pnl)
+# define PadARRAY AvARRAY
+# define PadMAX AvFILLp
+# define PadnameLEN(pn) SvCUR(pn)
+# define PadnameOUTER(pn) !!SvFAKE(pn)
+# define PadnamePV(pn) (SvPOKp(pn) ? SvPVX(pn) : NULL)
+# ifdef SvPAD_STATE
+# define PadnameSTATE(pn) SvPAD_STATE(pn)
+# else
+# define PadnameSTATE(pn) 0
+# endif
+#endif
+
#ifndef newSV_type
# define newSV_type(type) THX_newSV_type(aTHX_ type)
static SV *THX_newSV_type(pTHX_ svtype type)
@@ -278,6 +301,12 @@ static SV *THX_safe_av_fetch(pTHX_ AV *a
return ptr ? *ptr : &PL_sv_undef;
}
+#define safe_pad_fetch(pad, index) THX_safe_pad_fetch(aTHX_ pad, index)
+static SV *THX_safe_pad_fetch(pTHX_ PAD *pad, I32 index)
+{
+ return index > PadMAX(pad) ? &PL_sv_undef : PadARRAY(pad)[index];
+}
+
#define package_to_sv(pkg) THX_package_to_sv(aTHX_ pkg)
static SV *THX_package_to_sv(pTHX_ HV *pkg)
{
@@ -526,23 +555,24 @@ static OP *pp_current_pad(pTHX)
SV *functionsv = sv_2mortal(function_to_sv(function));
U32 seq = PL_curcop->cop_seq;
SV *seqsv = sv_2mortal(uv_to_sv(seq));
- AV *padlist = CvPADLIST(function);
- AV *padname = (AV*)*av_fetch(padlist, 0, 0);
- SV **pname = AvARRAY(padname);
- I32 fname = AvFILLp(padname);
- I32 fpad = AvFILLp(PL_comppad);
+ PADLIST *padlist = CvPADLIST(function);
+ PADNAMELIST *padname = PadlistNAMES(padlist);
+ PADNAME **pname = PadnamelistARRAY(padname);
+ I32 fname = PadnamelistMAX(padname);
+ I32 fpad = PadMAX(PL_comppad);
I32 ix;
AV *savedpad = newAV();
SV *savedpadsv = sv_2mortal(newRV_noinc((SV*)savedpad));
av_extend(savedpad, fpad);
av_fill(savedpad, fpad);
for(ix = (fpad<fname ? fpad : fname) + 1; ix--; ) {
- SV *namesv, *vsv, *vref;
- if((namesv = pname[ix]) &&
- SvPOKp(namesv) && SvCUR(namesv) > 1 &&
- (SvFAKE(namesv) ||
- (seq > COP_SEQ_RANGE_LOW(namesv) &&
- seq <= COP_SEQ_RANGE_HIGH(namesv))) &&
+ PADNAME *name;
+ SV *vsv, *vref;
+ if((name = pname[ix]) &&
+ PadnamePV(name) && PadnameLEN(name) > 1 &&
+ (PadnameOUTER(name) ||
+ (seq > COP_SEQ_RANGE_LOW(name) &&
+ seq <= COP_SEQ_RANGE_HIGH(name))) &&
(vsv = PL_curpad[ix])) {
vref = newRV_inc(vsv);
SvREADONLY_on(vref);
@@ -584,17 +614,19 @@ static OP *THX_gen_current_environment_o
* unless it is looked up at compile time.
*/
for(cv = CvOUTSIDE(PL_compcv); cv; cv = CvOUTSIDE(cv)) {
- AV *padlist, *padname;
- SV **pname;
+ PADLIST *padlist;
+ PADNAMELIST *padname;
+ PADNAME **pname;
I32 fname, ix;
padlist = CvPADLIST(cv);
if(!padlist) continue;
- padname = (AV*)*av_fetch(padlist, 0, 0);
- pname = AvARRAY(padname);
- fname = AvFILLp(padname);
+ padname = PadlistNAMES(padlist);
+ pname = PadnamelistARRAY(padname);
+ fname = PadnamelistMAX(padname);
for(ix = fname+1; ix--; ) {
- SV *namesv = pname[ix];
- if(namesv && SvPOKp(namesv) && SvCUR(namesv) > 1) {
+ PADNAME *name = pname[ix];
+ if(name && PadnamePV(name) &&
+ PadnameLEN(name) > 1) {
PADOFFSET po;
/*
* On Perls prior to 5.15.8,
@@ -609,7 +641,7 @@ static OP *THX_gen_current_environment_o
* The redundant assignment suppresses a
* compiler warning.
*/
- po = pad_findmy_sv(namesv, 0);
+ po = pad_findmy_sv(name, 0);
}
}
}
@@ -660,41 +692,42 @@ static OP *myck_entersub_curenv(pTHX_ OP
}
#define close_pad(func, outpad) THX_close_pad(aTHX_ func, outpad)
-static void THX_close_pad(pTHX_ CV *func, AV *outpad)
+static void THX_close_pad(pTHX_ CV *func, PAD *outpad)
{
#ifndef PARENT_PAD_INDEX
CV *out = CvOUTSIDE(func);
- AV *out_padlist = out ? CvPADLIST(out) : NULL;
- AV *out_padname =
- out_padlist ? (AV*)*av_fetch(out_padlist, 0, 0) : NULL;
- SV **out_pname = out_padname ? AvARRAY(out_padname) : NULL;
- I32 out_fname = out_padname ? AvFILLp(out_padname) : 0;
+ PADLIST *out_padlist = out ? CvPADLIST(out) : NULL;
+ PADLISTNAME *out_padname =
+ out_padlist ? PadlistNAMES(out_padlist) : NULL;
+ PADNAME **out_pname =
+ out_padname ? PadnamelistARRAY(out_padname) : NULL;
+ I32 out_fname = out_padname ? PadnamelistMAX(out_padname) : 0;
U32 out_seq = CvOUTSIDE_SEQ(func);
#endif /* !PARENT_PAD_INDEX */
- AV *padlist = CvPADLIST(func);
- AV *padname = (AV*)*av_fetch(padlist, 0, 0);
- AV *pad = (AV*)*av_fetch(padlist, 1, 0);
- SV **pname = AvARRAY(padname);
- SV **ppad = AvARRAY(pad);
- I32 fname = AvFILLp(padname);
- I32 fpad = AvFILLp(pad);
+ PADLIST *padlist = CvPADLIST(func);
+ PADNAMELIST *padname = PadlistNAMES(padlist);
+ PAD *pad = PadlistARRAY(padlist)[1];
+ PADNAME **pname = PadnamelistARRAY(padname);
+ SV **ppad = PadARRAY(pad);
+ I32 fname = PadnamelistMAX(padname);
+ I32 fpad = PadMAX(pad);
I32 ix;
for(ix = fname+1; ix--; ) {
- SV *namesv = pname[ix];
+ PADNAME *name = pname[ix];
I32 pix;
#ifndef PARENT_PAD_INDEX
I32 fpix;
#endif /* !PARENT_PAD_INDEX */
SV *vref, *vsv;
- if(!(namesv && SvFAKE(namesv))) continue;
+ if(!(name && PadnameOUTER(name))) continue;
#ifdef PARENT_PAD_INDEX
- pix = PARENT_PAD_INDEX(namesv);
+ pix = PARENT_PAD_INDEX(name);
#else /* !PARENT_PAD_INDEX */
fpix = 0;
for(pix = out_fname; pix != 0; pix--) {
SV *out_namesv = out_pname[pix];
if(!(out_namesv && SvPOKp(out_namesv) &&
- strEQ(SvPVX(out_namesv), SvPVX(namesv))))
+ strEQ(SvPVX(out_namesv), SvPVX(name))))
continue;
if(SvFAKE(out_namesv)) {
fpix = pix;
@@ -706,11 +739,11 @@ static void THX_close_pad(pTHX_ CV *func
if(pix == 0) pix = fpix;
#endif /* !PARENT_PAD_INDEX */
if(!(pix != 0 && ix <= fpad &&
- (vref = safe_av_fetch(outpad, pix), 1) &&
+ (vref = safe_pad_fetch(outpad, pix), 1) &&
SvROK(vref) && (vsv = SvRV(vref), 1) &&
- !(SvPADSTALE(vsv) && !SvPAD_STATE(namesv))))
+ !(SvPADSTALE(vsv) && !PadnameSTATE(name))))
croak("Variable \"%s\" is not available",
- SvPVX_const(namesv));
+ PadnamePV(name));
SvREFCNT_inc(vsv);
if(ppad[ix]) SvREFCNT_dec(ppad[ix]);
ppad[ix] = vsv;
@@ -721,7 +754,7 @@ static void THX_close_pad(pTHX_ CV *func
# define parse_file_as_sub_body(outpad) \
THX_parse_file_as_sub_body(aTHX_ outpad)
-static void THX_parse_file_as_sub_body(pTHX_ AV *outpad)
+static void THX_parse_file_as_sub_body(pTHX_ PAD *outpad)
{
OP *stmtseq;
ENTER;
@@ -877,7 +910,7 @@ static void THX_populate_pad(pTHX)
# define parse_file_as_sub_body(outpad) \
THX_parse_file_as_sub_body(aTHX_ outpad)
-static void THX_parse_file_as_sub_body(pTHX_ AV *outpad)
+static void THX_parse_file_as_sub_body(pTHX_ PAD *outpad)
{
OP *rootop, *startop;
int parse_fail;
@@ -1054,7 +1087,7 @@ CODE:
#endif /* !QLEX_START_LINE_IS_SAFE */
lex_start_simple(source);
parse_file_as_sub_body(
- array_from_sv(safe_av_fetch(enva, ENV_OUTSIDEPAD)));
+ (PAD *)array_from_sv(safe_av_fetch(enva, ENV_OUTSIDEPAD)));
lex_end();
if(PL_error_count) {
if(!(SvPOK(ERRSV) && SvCUR(ERRSV) != 0))
