PP(pp_nextstate)
{
PL_curcop = (COP*)PL_op;
+ PL_sawalias = 0;
TAINT_NOT; /* Each statement is presumed innocent */
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
FREETMPS;
PUSHs(save_scalar(cGVOP_gv));
else
PUSHs(GvSVn(cGVOP_gv));
+ if (GvREFCNT(cGVOP_gv) > 1 || GvALIASED_SV(cGVOP_gv))
+ PL_sawalias = TRUE;
RETURN;
}
+
+/* also used for: pp_lineseq() pp_regcmaybe() pp_scalar() pp_scope() */
+
PP(pp_null)
{
return NORMAL;
{
dSP;
XPUSHs(MUTABLE_SV(cGVOP_gv));
+ if (isGV(cGVOP_gv)
+ && (GvREFCNT(cGVOP_gv) > 1 || GvALIASED_SV(cGVOP_gv)))
+ PL_sawalias = TRUE;
RETURN;
}
+
+/* also used for: pp_andassign() */
+
PP(pp_and)
{
PERL_ASYNC_CHECK();
RETURN;
}
+
+/* also used for: pp_i_predec() pp_i_preinc() pp_predec() */
+
PP(pp_preinc)
{
dSP;
return NORMAL;
}
+
+/* also used for: pp_orassign() */
+
PP(pp_or)
{
dSP;
}
}
+
+/* also used for: pp_dor() pp_dorassign() */
+
PP(pp_defined)
{
dSP;
}
}
+
+/* also used for: pp_aelemfast_lex() */
+
PP(pp_aelemfast)
{
dSP;
/* Oversized hot code. */
+/* also used for: pp_say() */
+
PP(pp_print)
{
dSP; dMARK; dORIGMARK;
RETURN;
}
+
+/* also used for: pp_rv2hv() */
+/* also called directly by pp_lvavref */
+
PP(pp_rv2av)
{
dSP; dTOPss;
const I32 gimme = GIMME_V;
static const char an_array[] = "an ARRAY";
static const char a_hash[] = "a HASH";
- const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
+ const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV
+ || PL_op->op_type == OP_LVAVREF;
const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
SvGETMAGIC(sv);
if (is_pp_rv2av) {
AV *const av = MUTABLE_AV(sv);
- /* The guts of pp_rv2av, with no intending change to preserve history
- (until such time as we get tools that can do blame annotation across
- whitespace changes. */
+ /* The guts of pp_rv2av */
if (gimme == G_ARRAY) {
SP--;
PUTBACK;
* Don't bother if LHS is just an empty hash or array.
*/
- if ( (PL_op->op_private & OPpASSIGN_COMMON)
+ if ( (PL_op->op_private & OPpASSIGN_COMMON || PL_sawalias)
&& (
firstlelem != lastlelem
|| ! ((sv = *firstlelem))
hash = NULL;
while (LIKELY(lelem <= lastlelem)) {
+ bool alias = FALSE;
TAINT_NOT; /* Each item stands on its own, taintwise. */
sv = *lelem++;
+ if (UNLIKELY(!sv)) {
+ alias = TRUE;
+ sv = *lelem++;
+ ASSUME(SvTYPE(sv) == SVt_PVAV);
+ }
switch (SvTYPE(sv)) {
case SVt_PVAV:
ary = MUTABLE_AV(sv);
SV **didstore;
if (LIKELY(*relem))
SvGETMAGIC(*relem); /* before newSV, in case it dies */
- sv = newSV(0);
- sv_setsv_nomg(sv, *relem);
- *(relem++) = sv;
+ if (LIKELY(!alias)) {
+ sv = newSV(0);
+ sv_setsv_nomg(sv, *relem);
+ *relem = sv;
+ }
+ else {
+ if (!SvROK(*relem))
+ DIE(aTHX_ "Assigned value is not a reference");
+ if (SvTYPE(SvRV(*relem)) > SVt_PVLV)
+ /* diag_listed_as: Assigned value is not %s reference */
+ DIE(aTHX_
+ "Assigned value is not a SCALAR reference");
+ if (lval)
+ *relem = sv_mortalcopy(*relem);
+ /* XXX else check for weak refs? */
+ sv = SvREFCNT_inc_simple_NN(SvRV(*relem));
+ }
+ relem++;
didstore = av_store(ary,i++,sv);
if (magic) {
if (!didstore)
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
- else if (PL_op->op_private & OPpTARGET_MY)
+ else if (ARGTARG)
GETTARGET;
else {
TARG = DEFSV;
goto have_fp;
}
}
- fp = nextargv(PL_last_in_gv);
+ fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL);
if (!fp) { /* Note: fp != IoIFP(io) */
(void)do_close(PL_last_in_gv, FALSE); /* now it does*/
}
{
PerlIO_clearerr(fp);
if (IoFLAGS(io) & IOf_ARGV) {
- fp = nextargv(PL_last_in_gv);
+ fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL);
if (fp)
continue;
(void)do_close(PL_last_in_gv, FALSE);
sv = AvARRAY(av)[ix];
}
+ if (UNLIKELY(cx->cx_type & CXp_FOR_LVREF)) {
+ SvSetMagicSV(*itersvp, sv);
+ break;
+ }
+
if (LIKELY(sv)) {
if (UNLIKELY(SvIS_FREED(sv))) {
*itersvp = NULL;
Perl_croak(aTHX_ "Use of freed value in iteration");
}
if (SvPADTMP(sv)) {
- assert(!IS_PADGV(sv));
sv = newSVsv(sv);
}
else {
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
- else if (PL_op->op_private & OPpTARGET_MY)
+ else if (ARGTARG)
GETTARGET;
else {
TARG = DEFSV;
if (DO_UTF8(TARG) && !doutf8) {
nsv = sv_newmortal();
SvSetSV(nsv, dstr);
- if (PL_encoding)
- sv_recode_to_utf8(nsv, PL_encoding);
+ if (IN_ENCODING)
+ sv_recode_to_utf8(nsv, _get_encoding());
else
sv_utf8_upgrade(nsv);
c = SvPV_const(nsv, clen);
first = FALSE;
}
else {
- if (PL_encoding) {
+ if (IN_ENCODING) {
if (!nsv) nsv = sv_newmortal();
sv_copypv(nsv, repl);
- if (!DO_UTF8(nsv)) sv_recode_to_utf8(nsv, PL_encoding);
+ if (!DO_UTF8(nsv)) sv_recode_to_utf8(nsv, _get_encoding());
sv_catsv(dstr, nsv);
}
else sv_catsv(dstr, repl);
src = PL_stack_base[*PL_markstack_ptr];
if (SvPADTMP(src)) {
- assert(!IS_PADGV(src));
src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
PL_tmps_floor++;
}
SV* sub_name;
/* anonymous or undef'd function leaves us no recourse */
- if (CvANON(cv) || !(gv = CvGV(cv))) {
- if (CvNAMED(cv))
- DIE(aTHX_ "Undefined subroutine &%"HEKf" called",
- HEKfARG(CvNAME_HEK(cv)));
+ if (CvLEXICAL(cv) && CvHASGV(cv))
+ DIE(aTHX_ "Undefined subroutine &%"SVf" called",
+ SVfARG(cv_name(cv, NULL, 0)));
+ if (CvANON(cv) || !CvHASGV(cv)) {
DIE(aTHX_ "Undefined subroutine called");
}
/* autoloaded stub? */
- if (cv != GvCV(gv)) {
+ if (cv != GvCV(gv = CvGV(cv))) {
cv = GvCV(gv);
}
/* should call AUTOLOAD now? */
if (*MARK)
{
if (SvPADTMP(*MARK)) {
- assert(!IS_PADGV(*MARK));
*MARK = sv_mortalcopy(*MARK);
}
SvTEMP_off(*MARK);
while (items--) {
mark++;
if (*mark && SvPADTMP(*mark)) {
- assert(!IS_PADGV(*mark));
*mark = sv_mortalcopy(*mark);
}
}
if (CvANON(cv))
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
else {
- HEK *const hek = CvNAME_HEK(cv);
- SV *tmpstr;
- if (hek) {
- tmpstr = sv_2mortal(newSVhek(hek));
- }
- else {
- tmpstr = sv_newmortal();
- gv_efullname3(tmpstr, CvGV(cv), NULL);
- }
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
- SVfARG(tmpstr));
+ SVfARG(cv_name(cv,NULL,0)));
}
}
PP(pp_method_named)
{
dSP;
- SV* const sv = cSVOP_sv;
- U32 hash = SvSHARED_HASH(sv);
+ SV* const meth = cMETHOPx_meth(PL_op);
+ U32 hash = SvSHARED_HASH(meth);
- XPUSHs(method_common(sv, &hash));
+ XPUSHs(method_common(meth, &hash));
RETURN;
}
GV* iogv;
STRLEN packlen;
const char * const packname = SvPV_nomg_const(sv, packlen);
- const bool packname_is_utf8 = !!SvUTF8(sv);
- const HE* const he =
- (const HE *)hv_common(
- PL_stashcache, NULL, packname, packlen,
- packname_is_utf8 ? HVhek_UTF8 : 0, 0, NULL, 0
- );
-
- if (he) {
- stash = INT2PTR(HV*,SvIV(HeVAL(he)));
- DEBUG_o(Perl_deb(aTHX_ "PL_stashcache hit %p for '%"SVf"'\n",
- (void*)stash, SVfARG(sv)));
- goto fetch;
- }
+ const U32 packname_utf8 = SvUTF8(sv);
+ stash = gv_stashpvn(packname, packlen, packname_utf8 | GV_CACHE_ONLY);
+ if (stash) goto fetch;
if (!(iogv = gv_fetchpvn_flags(
- packname, packlen, SVf_UTF8 * packname_is_utf8, SVt_PVIO
+ packname, packlen, packname_utf8, SVt_PVIO
)) ||
!(ob=MUTABLE_SV(GvIO(iogv))))
{
SVfARG(meth));
}
/* assume it's a package name */
- stash = gv_stashpvn(packname, packlen, packname_is_utf8 ? SVf_UTF8 : 0);
- if (!stash)
- packsv = sv;
- else {
- SV* const ref = newSViv(PTR2IV(stash));
- (void)hv_store(PL_stashcache, packname,
- packname_is_utf8 ? -(I32)packlen : (I32)packlen, ref, 0);
- DEBUG_o(Perl_deb(aTHX_ "PL_stashcache caching %p for '%"SVf"'\n",
- (void*)stash, SVfARG(sv)));
- }
+ stash = gv_stashpvn(packname, packlen, packname_utf8);
+ if (!stash) packsv = sv;
goto fetch;
}
/* it _is_ a filehandle name -- replace with a reference */
https://perl5.git.perl.org / perl5.git / blobdiff