# be to fake up a dummy constant that will never actually be true.
foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED OPpCONST_NOVER
OPpPAD_STATE PMf_SKIPWHITE RXf_SKIPWHITE
- CVf_LOCKED OPpREVERSE_INPLACE
+ CVf_LOCKED OPpREVERSE_INPLACE OPpSUBSTR_REPL_FIRST
PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES)) {
eval { import B $_ };
no strict 'refs';
sub listop {
my $self = shift;
- my($op, $cx, $name) = @_;
+ my($op, $cx, $name, $kid) = @_;
my(@exprs);
my $parens = ($cx >= 5) || $self->{'parens'};
- my $kid = $op->first->sibling;
+ $kid ||= $op->first->sibling;
return $self->keyword($name) if null $kid;
my $first;
$name = "socketpair" if $name eq "sockpair";
sub pp_bless { listop(@_, "bless") }
sub pp_atan2 { maybe_targmy(@_, \&listop, "atan2") }
-sub pp_substr { maybe_local(@_, listop(@_, "substr")) }
+sub pp_substr {
+ my ($self,$op,$cx) = @_;
+ if ($op->private & OPpSUBSTR_REPL_FIRST) {
+ return
+ listop($self, $op, 7, "substr", $op->first->sibling->sibling)
+ . " = "
+ . $self->deparse($op->first->sibling, 7);
+ }
+ maybe_local(@_, listop(@_, "substr"))
+}
sub pp_vec { maybe_local(@_, listop(@_, "vec")) }
sub pp_index { maybe_targmy(@_, \&listop, "index") }
sub pp_rindex { maybe_targmy(@_, \&listop, "rindex") }
print sort(foo('bar'));
>>>>
print sort(foo('bar'));
+####
+# substr assignment
+substr(my $a, 0, 0) = (foo(), bar());
+$a++;
"enteriter");
$priv{$_}{8} = 'LVSUB' for qw(rv2av rv2gv rv2hv padav padhv aelem helem
aslice hslice av2arylen keys rkeys substr pos vec);
+$priv{substr}{16} = 'REPL1ST';
$priv{$_}{16} = "TARGMY"
for (map(($_,"s$_"),"chop", "chomp"),
map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo",
PMf_MULTILINE PMf_ONCE PMf_SINGLELINE
POSTFIX SVf_FAKE SVf_IOK SVf_NOK SVf_POK SVf_ROK
SVpad_OUR SVs_RMG SVs_SMG SWAP_CHILDREN OPpPAD_STATE
- OPpCONST_ARYBASE OPpEVAL_BYTES
+ OPpCONST_ARYBASE OPpEVAL_BYTES OPpSUBSTR_REPL_FIRST
/, $] > 5.009 ? ('RXf_SKIPWHITE') : ('PMf_SKIPWHITE'),
'CVf_LOCKED', # This ends up as a constant, pre or post 5.10
],
}
break;
+ case OP_SASSIGN:
+ if (OP_GIMME(o,0) == G_VOID) {
+ OP *right = cBINOP->op_first;
+ if (right) {
+ OP *left = right->op_sibling;
+ if (left->op_type == OP_SUBSTR
+ && (left->op_private & 7) < 4) {
+ op_null(o);
+ cBINOP->op_first = left;
+ right->op_sibling =
+ cBINOPx(left)->op_first->op_sibling;
+ cBINOPx(left)->op_first->op_sibling = right;
+ left->op_private |= OPpSUBSTR_REPL_FIRST;
+ }
+ }
+ }
+ break;
+
case OP_CUSTOM: {
Perl_cpeep_t cpeep =
XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_peep);
/* OP_RV2[AGH]V, OP_PAD[AH]V, OP_[AH]ELEM, OP_[AH]SLICE OP_AV2ARYLEN,
OP_R?KEYS, OP_SUBSTR, OP_POS, OP_VEC */
#define OPpMAYBE_LVSUB 8 /* We might be an lvalue to return */
+
+ /* OP_SUBSTR only */
+#define OPpSUBSTR_REPL_FIRST 16 /* 1st arg is replacement string */
+
/* OP_PADSV only */
#define OPpPAD_STATE 16 /* is a "state" pad */
/* for OP_RV2?V, lower bits carry hints (currently only HINT_STRICT_REFS) */
SV * len_sv;
IV len_iv = 0;
int len_is_uv = 1;
- const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+ I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
const bool rvalue = (GIMME_V != G_VOID);
const char *tmps;
SV *repl_sv = NULL;
if (num_args > 2) {
if (num_args > 3) {
- if((repl_sv = POPs)) {
- repl = SvPV_const(repl_sv, repl_len);
- repl_is_utf8 = DO_UTF8(repl_sv) && repl_len;
- }
- else num_args--;
+ if(!(repl_sv = POPs)) num_args--;
}
if ((len_sv = POPs)) {
len_iv = SvIV(len_sv);
pos1_iv = SvIV(pos_sv);
pos1_is_uv = SvIOK_UV(pos_sv);
sv = POPs;
+ if (PL_op->op_private & OPpSUBSTR_REPL_FIRST) {
+ assert(!repl_sv);
+ repl_sv = POPs;
+ }
PUTBACK;
if (repl_sv) {
+ repl = SvPV_const(repl_sv, repl_len);
+ repl_is_utf8 = DO_UTF8(repl_sv) && repl_len;
if (repl_is_utf8) {
if (!DO_UTF8(sv))
sv_utf8_upgrade(sv);
}
else if (DO_UTF8(sv))
repl_need_utf8_upgrade = TRUE;
+ lvalue = 0;
}
- if (lvalue && !repl) {
+ if (lvalue) {
tmps = NULL; /* unused */
SvGETMAGIC(sv);
if (SvOK(sv)) (void)SvPV_nomg_const(sv, curlen);
STRLEN byte_pos = utf8_curlen
? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos;
- if (lvalue && !repl) {
+ if (lvalue) {
SV * ret;
ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0);
repl = SvPV_const(repl_sv_copy, repl_len);
repl_is_utf8 = DO_UTF8(repl_sv_copy) && repl_len;
}
+ if (SvROK(sv))
+ Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
+ "Attempt to use reference as lvalue in substr"
+ );
if (!SvOK(sv))
sv_setpvs(sv, "");
sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
Use of uninitialized value $m2 in substr at - line 6.
Use of uninitialized value $g1 in substr at - line 6.
Use of uninitialized value $m1 in substr at - line 6.
-Use of uninitialized value $g2 in substr at - line 7.
Use of uninitialized value $m2 in substr at - line 7.
Use of uninitialized value $g1 in substr at - line 7.
+Use of uninitialized value $g2 in substr at - line 7.
Use of uninitialized value $m1 in substr at - line 7.
Use of uninitialized value $g1 in substr at - line 8.
-Use of uninitialized value in scalar assignment at - line 8.
-Use of uninitialized value $m1 in scalar assignment at - line 8.
+Use of uninitialized value $g2 in substr at - line 8.
+Use of uninitialized value $m1 in substr at - line 8.
Use of uninitialized value $m2 in substr at - line 9.
Use of uninitialized value $g1 in substr at - line 9.
-Use of uninitialized value in scalar assignment at - line 9.
-Use of uninitialized value $m1 in scalar assignment at - line 9.
+Use of uninitialized value $g2 in substr at - line 9.
+Use of uninitialized value $m1 in substr at - line 9.
Use of uninitialized value $m2 in vec at - line 11.
Use of uninitialized value $g1 in vec at - line 11.
Use of uninitialized value $m1 in vec at - line 11.