dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
{
dPOPTOPssrl;
- STRLEN llen;
- char* lpv;
bool lbyte;
STRLEN rlen;
- char* rpv = SvPV(right, rlen); /* mg_get(right) happens here */
- bool rbyte = !DO_UTF8(right), rcopied = FALSE;
+ const char *rpv = SvPV(right, rlen); /* mg_get(right) happens here */
+ const bool rbyte = !DO_UTF8(right);
+ bool rcopied = FALSE;
if (TARG == right && right != left) {
right = sv_2mortal(newSVpvn(rpv, rlen));
}
if (TARG != left) {
- lpv = SvPV(left, llen); /* mg_get(left) may happen here */
+ STRLEN llen;
+ const char* const lpv = SvPV(left, llen); /* mg_get(left) may happen here */
lbyte = !DO_UTF8(left);
sv_setpvn(TARG, lpv, llen);
if (!lbyte)
SvUTF8_off(TARG);
}
else { /* TARG == left */
+ STRLEN llen;
if (SvGMAGICAL(left))
mg_get(left); /* or mg_get(left) may happen here */
if (!SvOK(TARG))
sv_setpv(left, "");
- lpv = SvPV_nomg(left, llen);
+ (void)SvPV_nomg(left, llen); /* Needed to set UTF8 flag */
lbyte = !DO_UTF8(left);
if (IN_BYTES)
SvUTF8_off(TARG);
}
-#if defined(PERL_Y2KWARN)
- if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K) && SvOK(TARG)) {
- if (llen >= 2 && lpv[llen - 2] == '1' && lpv[llen - 1] == '9'
- && (llen == 2 || !isDIGIT(lpv[llen - 3])))
- {
- Perl_warner(aTHX_ packWARN(WARN_Y2K), "Possible Y2K bug: %s",
- "about to append an integer to '19'");
- }
- }
-#endif
-
if (lbyte != rbyte) {
if (lbyte)
sv_utf8_upgrade_nomg(TARG);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
{
- ++SvIVX(TOPs);
+ SvIV_set(TOPs, SvIVX(TOPs) + 1);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */
PP(pp_print)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
register PerlIO *fp;
PP(pp_aassign)
{
- dSP;
+ dVAR; dSP;
SV **lastlelem = PL_stack_sp;
SV **lastrelem = PL_stack_base + POPMARK;
SV **firstrelem = PL_stack_base + POPMARK + 1;
OP *
Perl_do_readline(pTHX)
{
- dSP; dTARGETSTACKED;
+ dVAR; dSP; dTARGETSTACKED;
register SV *sv;
STRLEN tmplen = 0;
STRLEN offset;
tmps = SvEND(sv) - 1;
if (*tmps == *SvPVX(PL_rs)) {
*tmps = '\0';
- SvCUR(sv)--;
+ SvCUR_set(sv, SvCUR(sv) - 1);
}
}
for (tmps = SvPVX(sv); *tmps; tmps++)
continue;
}
} else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
- U8 *s = (U8*)SvPVX(sv) + offset;
- STRLEN len = SvCUR(sv) - offset;
- U8 *f;
+ const U8 *s = (U8*)SvPVX(sv) + offset;
+ const STRLEN len = SvCUR(sv) - offset;
+ const U8 *f;
if (ckWARN(WARN_UTF8) &&
!Perl_is_utf8_string_loc(aTHX_ s, len, &f))
}
if (gimme == G_ARRAY) {
if (SvLEN(sv) - SvCUR(sv) > 20) {
- SvLEN_set(sv, SvCUR(sv)+1);
- Renew(SvPVX(sv), SvLEN(sv), char);
+ SvPV_shrink_to_cur(sv);
}
sv = sv_2mortal(NEWSV(58, 80));
continue;
}
else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
/* try to reclaim a bit of scalar space (only on 1st alloc) */
- if (SvCUR(sv) < 60)
- SvLEN_set(sv, 80);
- else
- SvLEN_set(sv, SvCUR(sv)+40); /* allow some slop */
- Renew(SvPVX(sv), SvLEN(sv), char);
+ const STRLEN new_len
+ = SvCUR(sv) < 60 ? 80 : SvCUR(sv)+40; /* allow some slop */
+ SvPV_renew(sv, new_len);
}
RETURN;
}
PP(pp_enter)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = OP_GIMME(PL_op, -1);
PP(pp_leave)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
register SV **mark;
SV **newsp;
/* string increment */
register SV* cur = cx->blk_loop.iterlval;
STRLEN maxlen = 0;
- char *max = SvOK((SV*)av) ? SvPV((SV*)av, maxlen) : "";
+ const char *max = SvOK((SV*)av) ? SvPV((SV*)av, maxlen) : "";
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
if (SvLEN(TARG))
Safefree(SvPVX(TARG));
}
- SvPVX(TARG) = SvPVX(dstr);
+ SvPV_set(TARG, SvPVX(dstr));
SvCUR_set(TARG, SvCUR(dstr));
SvLEN_set(TARG, SvLEN(dstr));
doutf8 |= DO_UTF8(dstr);
- SvPVX(dstr) = 0;
+ SvPV_set(dstr, (char*)0);
sv_free(dstr);
TAINT_IF(rxtainted & 1);
PP(pp_grepwhile)
{
- dSP;
+ dVAR; dSP;
if (SvTRUEx(POPs))
PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
PP(pp_leavesub)
{
- dSP;
+ dVAR; dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
* get any slower by more conditions */
PP(pp_leavesublv)
{
- dSP;
+ dVAR; dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
{
SV *dbsv = GvSV(PL_DBsub);
+ save_item(dbsv);
if (!PERLDB_SUB_NN) {
GV *gv = CvGV(cv);
- save_item(dbsv);
if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
|| strEQ(GvNAME(gv), "END")
|| ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
}
}
else {
- (void)SvUPGRADE(dbsv, SVt_PVIV);
+ const int type = SvTYPE(dbsv);
+ if (type < SVt_PVIV && type != SVt_IV)
+ sv_upgrade(dbsv, SVt_PVIV);
(void)SvIOK_on(dbsv);
- SAVEIV(SvIVX(dbsv));
- SvIVX(dbsv) = PTR2IV(cv); /* Do it the quickest way */
+ SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */
}
if (CvXSUB(cv))
PP(pp_entersub)
{
- dSP; dPOPss;
+ dVAR; dSP; dPOPss;
GV *gv;
HV *stash;
register CV *cv;
register PERL_CONTEXT *cx;
I32 gimme;
- bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
+ const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
if (!sv)
DIE(aTHX_ "Not a CODE reference");
break;
default:
if (!SvROK(sv)) {
- char *sym;
- STRLEN n_a;
-
+ const char *sym;
if (sv == &PL_sv_yes) { /* unfound import, ignore */
if (hasargs)
SP = PL_stack_base + POPMARK;
goto got_rv;
sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
}
- else
+ else {
+ STRLEN n_a;
sym = SvPV(sv, n_a);
+ }
if (!sym)
DIE(aTHX_ PL_no_usym, "a subroutine");
if (PL_op->op_private & HINT_STRICT_REFS)
sv_setiv(PL_DBassertion, 1);
cv = get_db_sub(&sv, cv);
- if (!cv)
- DIE(aTHX_ "No DBsub routine");
+ if (!cv || (!CvXSUB(cv) && !CvSTART(cv)))
+ DIE(aTHX_ "No DB::sub routine defined");
}
if (!(CvXSUB(cv))) {
ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
if (items > AvMAX(av) + 1) {
AvMAX(av) = items - 1;
Renew(ary,items,SV*);
AvALLOC(av) = ary;
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
}
Copy(MARK,AvARRAY(av),items,SV*);
SV* elemsv = POPs;
IV elem = SvIV(elemsv);
AV* av = (AV*)POPs;
- U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
- U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
+ const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
+ const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
SV *sv;
if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
static const char oom_array_extend[] =
"Out of memory during array extend"; /* Duplicated in av.c */
if (SvUOK(elemsv)) {
- UV uv = SvUV(elemsv);
+ const UV uv = SvUV(elemsv);
elem = uv > IV_MAX ? IV_MAX : uv;
}
else if (SvNOK(elemsv))
else if (SvTYPE(sv) >= SVt_PV) {
SvOOK_off(sv);
Safefree(SvPVX(sv));
- SvLEN(sv) = SvCUR(sv) = 0;
+ SvLEN_set(sv, 0);
+ SvCUR_set(sv, 0);
}
switch (to_what) {
case OPpDEREF_SV:
- SvRV(sv) = NEWSV(355,0);
+ SvRV_set(sv, NEWSV(355,0));
break;
case OPpDEREF_AV:
- SvRV(sv) = (SV*)newAV();
+ SvRV_set(sv, (SV*)newAV());
break;
case OPpDEREF_HV:
- SvRV(sv) = (SV*)newHV();
+ SvRV_set(sv, (SV*)newHV());
break;
}
SvROK_on(sv);
SV* ob;
GV* gv;
HV* stash;
- char* name;
STRLEN namelen;
- char* packname = 0;
+ const char* packname = 0;
SV *packsv = Nullsv;
STRLEN packlen;
+ const char *name = SvPV(meth, namelen);
- name = SvPV(meth, namelen);
sv = *(PL_stack_base + TOPMARK + 1);
if (!sv)
cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
don't want that.
*/
- char* leaf = name;
- char* sep = Nullch;
- char* p;
+ const char* leaf = name;
+ const char* sep = Nullch;
+ const char* p;
for (p = name; *p; p++) {
if (*p == '\'')
https://perl5.git.perl.org / perl5.git / blobdiff