summaryrefslogtreecommitdiff
path: root/pp_hot.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2018-02-19 11:59:03 +0000
committerDavid Mitchell <davem@iabyn.com>2018-02-19 22:06:49 +0000
commit55b62dee2d8dffa7b36b3b613ee4727fbefdb9e3 (patch)
treeaf99f9325739767173f08bc999ba0e8bfac281b5 /pp_hot.c
parent057ba76ababce335660483d8ac1f9a460182c91c (diff)
downloadperl-55b62dee2d8dffa7b36b3b613ee4727fbefdb9e3.tar.gz
pp_multiconcat: correctly honour stringify
RT #132793, RT #132801 In something like $x .= "$overloaded", the $overloaded stringify method wasn't being called. However, it turns that the existing (pre-multiconcat) behaviour is also buggy and inconsistent. That behaviour has been restored as-is. At some future time, these bugs might be addressed. Here are some comments from the new tests added to overload.t: Since 5.000, any OP_STRINGIFY immediately following an OP_CONCAT is optimised away, on the assumption that since concat will always return a valid string anyway, it doesn't need stringifying. So in "$x", the stringify is needed, but on "$x$y" it isn't. This assumption is flawed once overloading has been introduced, since concat might return an overloaded object which still needs stringifying. However, this flawed behaviour is apparently needed by at least one module, and is tested for in opbasic/concat.t: see RT #124160. There is also a wart with the OPpTARGET_MY optimisation: specifically, in $lex = "...", if $lex is a lexical var, then a chain of 2 or more concats *doesn't* optimise away OP_STRINGIFY: $lex = "$x"; # stringifies $lex = "$x$y"; # doesn't stringify $lex = "$x$y$z..."; # stringifies
Diffstat (limited to 'pp_hot.c')
-rw-r--r--pp_hot.c52
1 files changed, 44 insertions, 8 deletions
diff --git a/pp_hot.c b/pp_hot.c
index 37b73f5dd4..1cdc90aa27 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -361,8 +361,8 @@ In addition:
sprintf "...%s...". Don't call '.'
overloading: only use '""' overloading.
- OPpMULTICONCAT_STRINGIFY: (for Deparse's benefit) the RHS was of the
- form "...$a...$b..." rather than
+ OPpMULTICONCAT_STRINGIFY: the RHS was of the form
+ "...$a...$b..." rather than
"..." . $a . "..." . $b . "..."
An OP_MULTICONCAT is of type UNOP_AUX. The fixed slots of the aux array are
@@ -948,7 +948,7 @@ PP(pp_multiconcat)
SV **svp;
const char *cpv = aux[PERL_MULTICONCAT_IX_PLAIN_PV].pv;
UNOP_AUX_item *lens = aux + PERL_MULTICONCAT_IX_LENGTHS;
- bool first = TRUE; /* first call to S_do_concat */
+ Size_t arg_count = 0; /* how many args have been processed */
if (!cpv) {
cpv = aux[PERL_MULTICONCAT_IX_UTF8_PV].pv;
@@ -964,9 +964,44 @@ PP(pp_multiconcat)
*/
n = nargs *2 + 1;
- for (i = 0; i < n + is_append; i++) {
+ for (i = 0; i <= n; i++) {
+ SSize_t len;
+
+ /* if necessary, stringify the final RHS result in
+ * something like $targ .= "$a$b$c" - simulating
+ * pp_stringify
+ */
+ if ( i == n
+ && (PL_op->op_private &OPpMULTICONCAT_STRINGIFY)
+ && !(SvPOK(left))
+ /* extra conditions for backwards compatibility:
+ * probably incorrect, but keep the existing behaviour
+ * for now. The rules are:
+ * $x = "$ov" single arg: stringify;
+ * $x = "$ov$y" multiple args: don't stringify,
+ * $lex = "$ov$y$z" except TARGMY with at least 2 concats
+ */
+ && ( arg_count == 1
+ || ( arg_count >= 3
+ && !is_append
+ && (PL_op->op_private & OPpTARGET_MY)
+ && !(PL_op->op_private & OPpLVAL_INTRO)
+ )
+ )
+ )
+ {
+ SV *tmp = sv_newmortal();
+ sv_copypv(tmp, left);
+ SvSETMAGIC(tmp);
+ left = tmp;
+ }
+
+ /* do one extra iteration to handle $targ in $targ .= ... */
+ if (i == n && !is_append)
+ break;
+
/* get the next arg SV or regen the next const SV */
- SSize_t len = lens[i >> 1].ssize;
+ len = lens[i >> 1].ssize;
if (i == n) {
/* handle the final targ .= (....) */
right = left;
@@ -981,18 +1016,19 @@ PP(pp_multiconcat)
cpv += len;
}
- if (!left) {
+ arg_count++;
+
+ if (arg_count <= 1) {
left = right;
continue; /* need at least two SVs to concat together */
}
- if (first && i < n) {
+ if (arg_count == 2 && i < n) {
/* for the first concat, create a mortal acting like the
* padtmp from OP_CONST. In later iterations this will
* be appended to */
nexttarg = sv_newmortal();
nextappend = FALSE;
- first = FALSE;
}
else {
nexttarg = left;