Return fresh scalar from join(const,const)

$ perl5.20.1 -Ilib  -le 'for(1,2) { push @_, \join "x", 1 } print for @_'
SCALAR(0x7fb131005438)
SCALAR(0x7fb131005648)
$ ./perl -Ilib  -le 'for(1,2) { push @_, \join "x", 1 } print for @_'
SCALAR(0x7fe612831b30)
SCALAR(0x7fe612831b30)

Notice how we now get two references to the same scalar.  I broke this
accidentally in 987c9691.  If join has two arguments, it gets con-
verted to a stringify op.  The stringify op might get constant-folded,
and folding of stringify is special, because the parser uses it
itself to implement qq().  So I had ck_join set op_folded to flag
the op as being a folded join.  Only that came too late, because
op_convert_list(OP_STRINGIFY,...) folds the op before it returns it.
Hence, the folded constant was flagged the wrong way, and stopped
being implicitly copied by refgen (\).

diff --git a/op.c b/op.c
index 476d154..1ca2cd3 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4225,7 +4225,8 @@ S_fold_constants(pTHX_ OP *o)
     folded = cBOOL(o->op_folded);
     op_free(o);
     assert(sv);
-    if (type == OP_STRINGIFY) SvPADTMP_off(sv);
+    if (type == OP_STRINGIFY && !folded)
+       SvPADTMP_off(sv);
     else if (!SvIMMORTAL(sv)) {
        SvPADTMP_on(sv);
        SvREADONLY_on(sv);
@@ -4450,6 +4451,8 @@ Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
 
     CHANGE_TYPE(o, type);
     o->op_flags |= flags;
+    if (flags & OPf_FOLDED)
+       o->op_folded = 1;
 
     o = CHECKOP(type, o);
     if (o->op_type != (unsigned)type)
@@ -10973,10 +10976,9 @@ Perl_ck_join(pTHX_ OP *o)
        if (bairn && !OP_HAS_SIBLING(bairn) /* single-item list */
         && PL_opargs[bairn->op_type] & OA_RETSCALAR)
        {
-           OP * const ret = op_convert_list(OP_STRINGIFY, 0,
+           OP * const ret = op_convert_list(OP_STRINGIFY, OPf_FOLDED,
                                     op_sibling_splice(o, kid, 1, NULL));
            op_free(o);
-           ret->op_folded = 1;
            return ret;
        }
     }

diff --git a/op.h b/op.h
index 161c1a5..befdc79 100644 (file)
--- a/op.h
+++ b/op.h
@@ -139,6 +139,10 @@ Deprecated.  Use C<GIMME_V> instead.
                                 /*  On OP_PADRANGE, push @_ */
                                 /*  On OP_DUMP, has no label */
                                 /*  On OP_UNSTACK, in a C-style for loop */
+/* There is no room in op_flags for this one, so it has its own bit-
+   field member (op_folded) instead.  The flag is only used to tell
+   op_convert_list to set op_folded.  */
+#define OPf_FOLDED      1<<16
 
 /* old names; don't use in new code, but don't break them, either */
 #define OPf_LIST       OPf_WANT_LIST

diff --git a/t/op/join.t b/t/op/join.t
index 4117d49..17b618e 100644 (file)
--- a/t/op/join.t
+++ b/t/op/join.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 28;
+plan tests => 29;
 
 @x = (1, 2, 3);
 is( join(':',@x), '1:2:3', 'join an array with character');
@@ -124,3 +124,7 @@ package o { use overload q|""| => sub { ${$_[0]}++ } }
   is $_, "1a2a3a4a5a6a7a8a9a10", 'join, $overloaded, LIST';
   is $$o, "b", 'overloading was called once on overloaded separator';
 }
+
+for(1,2) { push @_, \join "x", 1 }
+isnt $_[1], $_[0],
+    'join(const, const) still returns a new scalar each time';