In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/fd017c00b1282d493d81ce54d392bc0c3a3ae001?hp=afc80078650f4c5361caace3f0ae6c934135d0ec>
- Log -----------------------------------------------------------------
commit fd017c00b1282d493d81ce54d392bc0c3a3ae001
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sat Oct 11 23:33:40 2014 -0700
Optimise @lexarray = split...
â@pkgary = split //, $fooâ gets optimised such that the split writes
directly to the array and the assignment doesnât have to happen.
This commit makes it work also with lexical arrays. It only works for
arrays declared previously; âmy @a = splitâ doesnât get optimised,
just as âlocal @a = splitâ doesnât.
The pad offset is stored in the op_targ field of the pushre op, just
as the GV is stored in its op_pmreplrootu field.
M lib/B/Deparse.pm
M op.c
M pp.c
commit e05542ee69e4e58f0e9b4f9d5348f4cd31449bcd
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sat Oct 11 23:24:00 2014 -0700
perlref: Document lvalue slice refs
Something I missed.
M pod/perlref.pod
commit 61a9f0702db84769557a6388593632f092ea8477
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sat Oct 11 23:22:24 2014 -0700
Clarify two panic perldiag entries
M pod/perldiag.pod
commit b3941ae985e6b767006431e538d0e45b5346ce29
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sat Oct 11 23:17:43 2014 -0700
pp.c:pp_split: Remove redundant !s
SvPV always returns something (or croaks), so s cannot be null here.
M pp.c
-----------------------------------------------------------------------
Summary of changes:
lib/B/Deparse.pm | 2 ++
op.c | 34 +++++++++++++++++++++++++---------
pod/perldiag.pod | 7 +++++--
pod/perlref.pod | 6 +++++-
pp.c | 4 ++--
5 files changed, 39 insertions(+), 14 deletions(-)
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 07cf10f..00a9a3c 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -4976,6 +4976,8 @@ sub pp_split {
$gv = $replroot;
} elsif (!ref($replroot) and $replroot > 0) {
$gv = $self->padval($replroot);
+ } elsif ($kid->targ) {
+ $ary = $self->padname($kid->targ)
}
$ary = $self->maybe_local(@_,
$self->stash_variable('@',
diff --git a/op.c b/op.c
index be6f936..9f2db9c 100644
--- a/op.c
+++ b/op.c
@@ -1695,6 +1695,7 @@ Perl_scalarvoid(pTHX_ OP *o)
case OP_SPLIT:
kid = cLISTOPo->op_first;
if (kid && kid->op_type == OP_PUSHRE
+ && !kid->op_targ
#ifdef USE_ITHREADS
&& !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff)
#else
@@ -5921,6 +5922,7 @@ S_aassign_common_vars(pTHX_ OP* o)
curop->op_type == OP_PADHV ||
curop->op_type == OP_PADANY)
{
+ padcheck:
if (PAD_COMPNAME_GEN(curop->op_targ)
== (STRLEN)PL_generation
|| PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
@@ -5952,6 +5954,8 @@ S_aassign_common_vars(pTHX_ OP* o)
return TRUE;
GvASSIGN_GENERATION_set(gv, PL_generation);
}
+ else if (curop->op_targ)
+ goto padcheck;
}
else if (curop->op_type == OP_PADRANGE)
/* Ignore padrange; checking its siblings is sufficient. */
@@ -5983,6 +5987,10 @@ S_aassign_common_vars_aliases_only(pTHX_ OP *o)
&& PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
return TRUE;
+ if (curop->op_type == OP_PUSHRE && curop->op_targ
+ && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
+ return TRUE;
+
if (curop->op_flags & OPf_KIDS) {
if (S_aassign_common_vars_aliases_only(aTHX_ curop))
return TRUE;
@@ -6125,27 +6133,35 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
#else
!pm->op_pmreplrootu.op_pmtargetgv
#endif
+ && !pm->op_targ
) {
- if (left->op_type == OP_RV2AV &&
- !(left->op_private & OPpLVAL_INTRO) &&
- (tmpop = ((UNOP*)left)->op_first)->op_type == OP_GV
+ if (!(left->op_private & OPpLVAL_INTRO) &&
+ ( (left->op_type == OP_RV2AV &&
+ (tmpop=((UNOP*)left)->op_first)->op_type==OP_GV)
+ || left->op_type == OP_PADAV )
) {
+ if (tmpop != (OP *)pm) {
#ifdef USE_ITHREADS
- pm->op_pmreplrootu.op_pmtargetoff
+ pm->op_pmreplrootu.op_pmtargetoff
= cPADOPx(tmpop)->op_padix;
- cPADOPx(tmpop)->op_padix = 0; /* steal it */
+ cPADOPx(tmpop)->op_padix = 0; /* steal it */
#else
- pm->op_pmreplrootu.op_pmtargetgv
+ pm->op_pmreplrootu.op_pmtargetgv
= MUTABLE_GV(cSVOPx(tmpop)->op_sv);
- cSVOPx(tmpop)->op_sv = NULL; /* steal it */
+ cSVOPx(tmpop)->op_sv = NULL; /* steal it */
#endif
+ right->op_private |=
+ left->op_private & OPpOUR_INTRO;
+ }
+ else {
+ pm->op_targ = left->op_targ;
+ left->op_targ = 0; /* filch it */
+ }
tmpop = cUNOPo->op_first; /* to list (nulled) */
tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
/* detach rest of siblings from o subtree,
* and free subtree */
op_sibling_splice(cUNOPo->op_first, tmpop, -1, NULL);
- right->op_private |=
- left->op_private & OPpOUR_INTRO;
op_free(o); /* blow off assign */
right->op_flags &= ~OPf_WANT;
/* "I don't know and I don't care." */
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 0d3239b..0d6dce3 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4138,7 +4138,8 @@ and freeing temporaries and lexicals from.
=item panic: pad_free po
-(P) An invalid scratch pad offset was detected internally.
+(P) An zero scratch pad offset was detected internally. An attempt was
+made to free a target that had not been allocated to begin with.
=item panic: pad_reset curpad, %p!=%p
@@ -4147,7 +4148,9 @@ and freeing temporaries and lexicals from.
=item panic: pad_sv po
-(P) An invalid scratch pad offset was detected internally.
+(P) A zero scratch pad offset was detected internally. Most likely
+an operator needed a target but that target had not been allocated
+for whatever reason.
=item panic: pad_swipe curpad, %p!=%p
diff --git a/pod/perlref.pod b/pod/perlref.pod
index e71b7c7..5df9a70 100644
--- a/pod/perlref.pod
+++ b/pod/perlref.pod
@@ -838,8 +838,12 @@ evaluated in scalar context:
\local $some_hash{$key}
condition ? \$this : \$that[0] # etc.
-Parentheses cause the right-hand side to be evaluated in list context:
+Array slices and parentheses cause the right-hand side to be evaluated in
+list context:
+ \@array[5..7]
+ (\@array[5..7])
+ \(@array[5..7])
(\$scalar)
\($scalar)
\(my $scalar)
diff --git a/pp.c b/pp.c
index b859236..80dae1e 100644
--- a/pp.c
+++ b/pp.c
@@ -5561,7 +5561,7 @@ PP(pp_split)
#else
pm = (PMOP*)POPs;
#endif
- if (!pm || !s)
+ if (!pm)
DIE(aTHX_ "panic: pp_split, pm=%p, s=%p", pm, s);
rx = PM_GETRE(pm);
@@ -5578,7 +5578,7 @@ PP(pp_split)
}
#endif
else
- ary = NULL;
+ ary = pm->op_targ ? (AV *)PAD_SVl(pm->op_targ) : NULL;
if (ary) {
realarray = 1;
PUTBACK;
--
Perl5 Master Repository
