t/op/not.t See if not works
t/op/numconvert.t See if accessing fields does not change numeric values
t/op/oct.t See if oct and hex work
+t/op/opt.t Test presence of some op optimisations
t/op/ord.t See if ord works
t/op/or.t See if || works in weird situations
t/op/overload_integer.t See if overload::constant for integer works after "use".
use strict;
use Test::More;
-plan tests => 4018;
+plan tests => 4006;
use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature
# logic to add CORE::
index 23 p
int 01 $
ioctl 3 p
-join 123 p
+join 13 p
keys 1 - # also tested specially
kill 123 p
# last handled specially
OP * VOL curop;
OP *newop;
VOL I32 type = o->op_type;
+ bool folded;
SV * VOL sv = NULL;
int ret = 0;
I32 oldscope;
if (ret)
goto nope;
+ folded = o->op_folded;
op_free(o);
assert(sv);
if (type == OP_STRINGIFY) SvPADTMP_off(sv);
else
{
newop = newSVOP(OP_CONST, 0, MUTABLE_SV(sv));
- if (type != OP_STRINGIFY) newop->op_folded = 1;
+ /* OP_STRINGIFY and constant folding are used to implement qq.
+ Here the constant folding is an implementation detail that we
+ want to hide. If the stringify op is itself already marked
+ folded, however, then it is actually a folded join. */
+ if (type != OP_STRINGIFY || folded) newop->op_folded = 1;
}
return newop;
OP *
Perl_ck_join(pTHX_ OP *o)
{
- const OP * const kid = OP_SIBLING(cLISTOPo->op_first);
+ OP * const kid = OP_SIBLING(cLISTOPo->op_first);
PERL_ARGS_ASSERT_CK_JOIN;
SVfARG(msg), SVfARG(msg));
}
}
+ if (kid->op_type == OP_CONST /* an innocent, unsuspicious separator */
+ || (kid->op_type == OP_PADSV && !(kid->op_private & OPpLVAL_INTRO))
+ || (kid->op_type==OP_RV2SV && kUNOP->op_first->op_type == OP_GV
+ && !(kid->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO))))
+ {
+ const OP * const bairn = OP_SIBLING(kid); /* the list */
+ if (bairn && !OP_HAS_SIBLING(bairn) /* single-item list */
+ && PL_opargs[bairn->op_type] & OA_RETSCALAR)
+ {
+ OP * const ret = convert(OP_STRINGIFY, 0,
+ op_sibling_splice(o, kid, 1, NULL));
+ op_free(o);
+ ret->op_folded = 1;
+ return ret;
+ }
+ }
+
return ck_fun(o);
}
0x00091480, /* unpack */
0x0002140f, /* pack */
0x00111408, /* split */
- 0x0002140d, /* join */
+ 0x0002140f, /* join */
0x00002401, /* list */
0x00224200, /* lslice */
0x00002405, /* anonlist */
unpack unpack ck_fun u@ S S?
pack pack ck_fun fmst@ S L
split split ck_split t@ S S S
-join join or string ck_join mst@ S L
+join join or string ck_join fmst@ S L
# List operators.
{
if (PL_op) {
SV* varname = NULL;
+ const char *desc;
if (uninit_sv && PL_curpad) {
varname = find_uninit_var(PL_op, uninit_sv,0);
if (varname)
sv_insert(varname, 0, 0, " ", 1);
}
+ desc = PL_op->op_type == OP_STRINGIFY && PL_op->op_folded
+ ? "join or string"
+ : OP_DESC(PL_op);
/* PL_warn_uninit_sv is constant */
GCC_DIAG_IGNORE(-Wformat-nonliteral);
/* diag_listed_as: Use of uninitialized value%s */
Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit_sv,
SVfARG(varname ? varname : &PL_sv_no),
- " in ", OP_DESC(PL_op));
+ " in ", desc);
GCC_DIAG_RESTORE;
}
else {
Use of uninitialized value $g1 in split at - line 8.
Use of uninitialized value $m2 in split at - line 8.
Use of uninitialized value $m1 in join or string at - line 10.
-Use of uninitialized value $m1 in join or string at - line 11.
Use of uninitialized value $m2 in join or string at - line 11.
Use of uninitialized value $m1 in join or string at - line 12.
Use of uninitialized value $m2 in join or string at - line 12.
@a{0} ; # OP_HSLICE
unpack "a", "a" ; # OP_UNPACK
pack $a,"" ; # OP_PACK
-join "" ; # OP_JOIN
+join "", @_ ; # OP_JOIN
(@a)[0,1] ; # OP_LSLICE
# OP_ANONLIST
# OP_ANONHASH
--- /dev/null
+#!./perl
+
+# Use B to test that optimisations are not inadvertently removed.
+
+BEGIN {
+ chdir 't';
+ require './test.pl';
+ skip_all_if_miniperl("No B under miniperl");
+ @INC = '../lib';
+}
+
+plan 11;
+
+use B 'svref_2object';
+
+for (['CONSTANT', sub { join "foo", $_ }],
+ ['$var' , sub { join $_ , $_ }],
+ ['$myvar' , sub { my $var; join $var, $_ }],
+) {
+ my($sep,$sub) = @$_;
+ my $last_expr = svref_2object($sub)->ROOT->first->last;
+ is $last_expr->name, 'stringify',
+ "join($sep, \$scalar) optimised to stringify";
+}
+
+for (['CONSTANT', sub { join "foo", "bar" }, 0, "bar" ],
+ ['CONSTANT', sub { join "foo", "bar", 3 }, 1, "barfoo3"],
+ ['$var' , sub { join $_ , "bar" }, 0, "bar" ],
+ ['$myvar' , sub { my $var; join $var, "bar" }, 0, "bar" ],
+) {
+ my($sep,$sub,$is_list,$expect) = @$_;
+ my $last_expr = svref_2object($sub)->ROOT->first->last;
+ my $tn = "join($sep, " . ($is_list?'list of constants':'const') . ")";
+ is $last_expr->name, 'const', "$tn optimised to constant";
+ is $sub->(), $expect, "$tn folded correctly";
+}