diff -rup Data-Alias-1.18-7uiCBM-orig/Alias.xs Data-Alias-1.18-7uiCBM/Alias.xs --- Data-Alias-1.18-7uiCBM-orig/Alias.xs 2014-12-16 14:56:52.000000000 -0800 +++ Data-Alias-1.18-7uiCBM/Alias.xs 2014-12-20 06:09:38.000000000 -0800 @@ -137,6 +137,11 @@ #define IS_PADGV(x) 0 #endif +#ifndef PadnamelistARRAY +#define PadnamelistARRAY AvARRAY +#define PadnameOUTER SvFAKE +#endif + #define DA_HAVE_OP_PADRANGE (PERL_COMBI_VERSION >= 5017006) #if DA_HAVE_OP_PADRANGE @@ -225,6 +230,8 @@ static char const msg_no_symref[] = STATIC OP *(*da_old_ck_rv2cv)(pTHX_ OP *op); STATIC OP *(*da_old_ck_entersub)(pTHX_ OP *op); +STATIC OP *(*da_old_ck_aelem)(pTHX_ OP *op); +STATIC OP *(*da_old_ck_helem)(pTHX_ OP *op); #ifdef USE_ITHREADS @@ -1489,7 +1496,9 @@ STATIC OP *DataAlias_pp_copy(pTHX) { STATIC void da_lvalue(pTHX_ OP *op, int list) { switch (op->op_type) { case OP_PADSV: op->op_ppaddr = DataAlias_pp_padsv; - if (SvFAKE(AvARRAY(PL_comppad_name)[op->op_targ]) + if (PadnameOUTER( + PadnamelistARRAY(PL_comppad_name) + [op->op_targ]) && ckWARN(WARN_CLOSURE)) Perl_warner(aTHX_ packWARN(WARN_CLOSURE), DA_OUTER_ERR); @@ -1501,7 +1510,8 @@ STATIC void da_lvalue(pTHX_ OP *op, int int i; if (!list) goto bad; for(i = start; i != start+count; i++) { - if (SvFAKE(AvARRAY(PL_comppad_name)[i]) + if (PadnameOUTER( + PadnamelistARRAY(PL_comppad_name)[i]) && ckWARN(WARN_CLOSURE)) Perl_warner(aTHX_ packWARN(WARN_CLOSURE), DA_OUTER_ERR); @@ -1785,7 +1795,7 @@ STATIC int da_transform(pTHX_ OP *op, in } STATIC void da_peep2(pTHX_ OP *o) { - OP *sib, *k; + OP *sib, *k, *o2; int useful; while (o->op_ppaddr != da_tag_list) { while ((sib = o->op_sibling)) { @@ -1805,14 +1815,20 @@ STATIC void da_peep2(pTHX_ OP *o) { useful = o->op_private & OPpUSEFUL; op_null(o); o->op_ppaddr = PL_ppaddr[OP_NULL]; - cLISTOPo->op_last = cUNOPx(cLISTOPo->op_first)->op_first; - k = o = cLISTOPo->op_first; + k = o2 = cLISTOPo->op_first; while ((sib = k->op_sibling)) k = sib; - if (!(sib = cUNOPo->op_first) || sib->op_ppaddr != da_tag_rv2cv) { + if (!(sib = cUNOPx(o2)->op_first) + || sib->op_ppaddr != da_tag_rv2cv) + { Perl_warn(aTHX_ "da peep weirdness 1"); } else { +#ifdef op_sibling_splice + op_sibling_splice(o, k, 0, sib); +#else + cLISTOPo->op_last = sib; k->op_sibling = sib; +#endif if (!(k = sib->op_next) || k->op_ppaddr != da_tag_entersub) { Perl_warn(aTHX_ "da peep weirdness 2"); } else { @@ -2005,6 +2021,9 @@ STATIC OP *da_ck_entersub(pTHX_ OP *o) { kid->op_private |= OPpUSEFUL; else kid->op_private &= ~OPpUSEFUL; + /* Defeat list+pushmark optimisation from v5.21.5-9-g6aa6830. */ + assert(kUNOP->op_first->op_type == OP_PUSHMARK); + kUNOP->op_first->op_type = OP_CUSTOM; tmp = kLISTOP->op_first; if (inside) op_null(tmp); @@ -2016,6 +2035,9 @@ STATIC OP *da_ck_entersub(pTHX_ OP *o) { while (kid->op_sibling != last) kid = kid->op_sibling; kid->op_sibling = Nullop; +#ifdef op_sibling_splice + kid->op_lastsib = 1; +#endif cLISTOPx(cUNOPo->op_first)->op_last = kid; if (kid->op_type == OP_NULL && inside) kid->op_flags &= ~OPf_SPECIAL; @@ -2023,6 +2045,14 @@ STATIC OP *da_ck_entersub(pTHX_ OP *o) { return o; } +/* These two exist solely to defeat the multideref optimisation. */ +STATIC OP *da_ck_aelem(pTHX_ OP *o) { + return da_old_ck_aelem(aTHX_ o); +} +STATIC OP *da_ck_helem(pTHX_ OP *o) { + return da_old_ck_helem(aTHX_ o); +} + MODULE = Data::Alias PACKAGE = Data::Alias @@ -2040,6 +2070,10 @@ BOOT: PL_check[OP_RV2CV] = da_ck_rv2cv; da_old_ck_entersub = PL_check[OP_ENTERSUB]; PL_check[OP_ENTERSUB] = da_ck_entersub; + da_old_ck_aelem = PL_check[OP_AELEM]; + PL_check[OP_AELEM] = da_ck_aelem; + da_old_ck_helem = PL_check[OP_HELEM]; + PL_check[OP_HELEM] = da_ck_helem; } CvLVALUE_on(get_cv("Data::Alias::deref", TRUE)); da_old_peepp = PL_peepp;