summaryrefslogtreecommitdiff
path: root/sv.c
diff options
context:
space:
mode:
Diffstat (limited to 'sv.c')
-rw-r--r--sv.c104
1 files changed, 71 insertions, 33 deletions
diff --git a/sv.c b/sv.c
index b795b299f3..5fd6533e43 100644
--- a/sv.c
+++ b/sv.c
@@ -1497,6 +1497,9 @@ Perl_sv_2iv(pTHX_ register SV *sv)
return SvIV(tmpstr);
return PTR2IV(SvRV(sv));
}
+ if (SvREADONLY(sv) && SvFAKE(sv)) {
+ sv_force_normal(sv);
+ }
if (SvREADONLY(sv) && !SvOK(sv)) {
dTHR;
if (ckWARN(WARN_UNINITIALIZED))
@@ -2745,12 +2748,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
if (!GvCVGEN((GV*)dstr) &&
(CvROOT(cv) || CvXSUB(cv)))
{
- SV *const_sv = cv_const_sv(cv);
- bool const_changed = TRUE;
- if(const_sv)
- const_changed = sv_cmp(const_sv,
- op_const_sv(CvSTART((CV*)sref),
- (CV*)sref));
+ SV *const_sv;
/* ahem, death to those who redefine
* active sort subs */
if (PL_curstackinfo->si_type == PERLSI_SORT &&
@@ -2758,11 +2756,20 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
Perl_croak(aTHX_
"Can't redefine active sort subroutine %s",
GvENAME((GV*)dstr));
- if ((const_changed && const_sv) || ckWARN(WARN_REDEFINE))
- Perl_warner(aTHX_ WARN_REDEFINE, const_sv ?
- "Constant subroutine %s redefined"
- : "Subroutine %s redefined",
- GvENAME((GV*)dstr));
+ /* Redefining a sub - warning is mandatory if
+ it was a const and its value changed. */
+ if (ckWARN(WARN_REDEFINE)
+ || (CvCONST(cv)
+ && (!CvCONST((CV*)sref)
+ || sv_cmp(cv_const_sv(cv),
+ cv_const_sv((CV*)sref)))))
+ {
+ Perl_warner(aTHX_ WARN_REDEFINE,
+ CvCONST(cv)
+ ? "Constant subroutine %s redefined"
+ : "Subroutine %s redefined",
+ GvENAME((GV*)dstr));
+ }
}
cv_ckproto(cv, (GV*)dstr,
SvPOK(sref) ? SvPVX(sref) : Nullch);
@@ -6050,7 +6057,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
bool has_precis = FALSE;
STRLEN precis = 0;
bool is_utf = FALSE;
-
+
char esignbuf[4];
U8 utf8buf[UTF8_MAXLEN];
STRLEN esignlen = 0;
@@ -6078,6 +6085,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
STRLEN gap;
char *dotstr = ".";
STRLEN dotstrlen = 1;
+ I32 epix = 0; /* explicit parameter index */
+ I32 ewix = 0; /* explicit width index */
+ bool asterisk = FALSE;
for (q = p; q < patend && *q != '%'; ++q) ;
if (q > p) {
@@ -6138,6 +6148,15 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
/* WIDTH */
+ scanwidth:
+
+ if (*q == '*') {
+ if (asterisk)
+ goto unknown;
+ asterisk = TRUE;
+ q++;
+ }
+
switch (*q) {
case '1': case '2': case '3':
case '4': case '5': case '6':
@@ -6145,17 +6164,30 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
width = 0;
while (isDIGIT(*q))
width = width * 10 + (*q++ - '0');
- break;
+ if (*q == '$') {
+ if (asterisk && ewix == 0) {
+ ewix = width;
+ width = 0;
+ q++;
+ goto scanwidth;
+ } else if (epix == 0) {
+ epix = width;
+ width = 0;
+ q++;
+ goto scanwidth;
+ } else
+ goto unknown;
+ }
+ }
- case '*':
+ if (asterisk) {
if (args)
i = va_arg(*args, int);
else
- i = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
+ i = (ewix ? ewix <= svmax : svix < svmax) ?
+ SvIVx(svargs[ewix ? ewix-1 : svix++]) : 0;
left |= (i < 0);
width = (i < 0) ? -i : i;
- q++;
- break;
}
/* PRECISION */
@@ -6166,7 +6198,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
if (args)
i = va_arg(*args, int);
else
- i = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
+ i = (ewix ? ewix <= svmax : svix < svmax)
+ ? SvIVx(svargs[ewix ? ewix-1 : svix++]) : 0;
precis = (i < 0) ? 0 : i;
q++;
}
@@ -6184,8 +6217,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
vecstr = (U8*)SvPVx(vecsv,veclen);
utf = DO_UTF8(vecsv);
}
- else if (svix < svmax) {
- vecsv = svargs[svix++];
+ else if (epix ? epix <= svmax : svix < svmax) {
+ vecsv = svargs[epix ? epix-1 : svix++];
vecstr = (U8*)SvPVx(vecsv,veclen);
utf = DO_UTF8(vecsv);
}
@@ -6239,7 +6272,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
if (args)
uv = va_arg(*args, int);
else
- uv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
+ uv = (epix ? epix <= svmax : svix < svmax) ?
+ SvIVx(svargs[epix ? epix-1 : svix++]) : 0;
if ((uv > 255 || (uv > 127 && SvUTF8(sv))) && !IN_BYTE) {
eptr = (char*)utf8buf;
elen = uv_to_utf8((U8*)eptr, uv) - utf8buf;
@@ -6268,8 +6302,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
elen = sizeof nullstr - 1;
}
}
- else if (svix < svmax) {
- argsv = svargs[svix++];
+ else if (epix ? epix <= svmax : svix < svmax) {
+ argsv = svargs[epix ? epix-1 : svix++];
eptr = SvPVx(argsv, elen);
if (DO_UTF8(argsv)) {
if (has_precis && precis < elen) {
@@ -6312,7 +6346,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
if (args)
uv = PTR2UV(va_arg(*args, void*));
else
- uv = (svix < svmax) ? PTR2UV(svargs[svix++]) : 0;
+ uv = (epix ? epix <= svmax : svix < svmax) ?
+ PTR2UV(svargs[epix ? epix-1 : svix++]) : 0;
base = 16;
goto integer;
@@ -6326,13 +6361,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
case 'd':
case 'i':
if (vectorize) {
- I32 ulen;
+ STRLEN ulen;
if (!veclen) {
vectorize = FALSE;
break;
}
if (utf)
- iv = (IV)utf8_to_uv_chk(vecstr, &ulen, 0);
+ iv = (IV)utf8_to_uv(vecstr, veclen, &ulen, 0);
else {
iv = *vecstr;
ulen = 1;
@@ -6352,7 +6387,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
}
}
else {
- iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
+ iv = (epix ? epix <= svmax : svix < svmax) ?
+ SvIVx(svargs[epix ? epix-1 : svix++]) : 0;
switch (intsize) {
case 'h': iv = (short)iv; break;
default: break;
@@ -6407,14 +6443,14 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
uns_integer:
if (vectorize) {
- I32 ulen;
+ STRLEN ulen;
vector:
if (!veclen) {
vectorize = FALSE;
break;
}
if (utf)
- uv = utf8_to_uv_chk(vecstr, &ulen, 0);
+ uv = utf8_to_uv(vecstr, veclen, &ulen, 0);
else {
uv = *vecstr;
ulen = 1;
@@ -6434,7 +6470,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
}
}
else {
- uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0;
+ uv = (epix ? epix <= svmax : svix < svmax) ?
+ SvUVx(svargs[epix ? epix-1 : svix++]) : 0;
switch (intsize) {
case 'h': uv = (unsigned short)uv; break;
default: break;
@@ -6526,7 +6563,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
if (args)
nv = va_arg(*args, NV);
else
- nv = (svix < svmax) ? SvNVx(svargs[svix++]) : 0.0;
+ nv = (epix ? epix <= svmax : svix < svmax) ?
+ SvNVx(svargs[epix ? epix-1 : svix++]) : 0.0;
need = 0;
if (c != 'e' && c != 'E') {
@@ -6611,8 +6649,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
#endif
}
}
- else if (svix < svmax)
- sv_setuv_mg(svargs[svix++], (UV)i);
+ else if (epix ? epix <= svmax : svix < svmax)
+ sv_setuv_mg(svargs[epix ? epix-1 : svix++], (UV)i);
continue; /* not "break" */
/* UNKNOWN */
View Lorry Controller Status