MAGIC* magic;
HV* stash;
+ if (mt != SVt_PV && SvREADONLY(sv) && SvFAKE(sv)) {
+ sv_force_normal(sv);
+ }
+
if (SvTYPE(sv) == mt)
return TRUE;
mt = SVt_PVNV;
break;
case SVt_PVIV:
- if (SvREADONLY(sv) && SvFAKE(sv)) {
- sv_force_normal(sv);
- }
pv = SvPVX(sv);
cur = SvCUR(sv);
len = SvLEN(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))
if (!utf8_to_bytes((U8*)c, &len)) {
if (fail_ok)
return FALSE;
- else
- Perl_croak(aTHX_ "big byte");
+ else {
+ if (PL_op)
+ Perl_croak(aTHX_ "Wide character in %s",
+ PL_op_desc[PL_op->op_type]);
+ else
+ Perl_croak(aTHX_ "Wide character");
+ }
}
SvCUR(sv) = len - 1;
SvUTF8_off(sv);
SvIVX(dstr) = SvIVX(sstr);
if (SvIsUV(sstr))
SvIsUV_on(dstr);
- SvTAINT(dstr);
+ if (SvTAINTED(sstr))
+ SvTAINT(dstr);
return;
}
goto undef_sstr;
}
SvNVX(dstr) = SvNVX(sstr);
(void)SvNOK_only(dstr);
- SvTAINT(dstr);
+ if (SvTAINTED(sstr))
+ SvTAINT(dstr);
return;
}
goto undef_sstr;
GvINTRO_off(dstr); /* one-shot flag */
gp_free((GV*)dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
- SvTAINT(dstr);
+ if (SvTAINTED(sstr))
+ SvTAINT(dstr);
if (GvIMPORTED(dstr) != GVf_IMPORTED
&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
{
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 &&
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);
SvREFCNT_dec(dref);
if (intro)
SAVEFREESV(sref);
- SvTAINT(dstr);
+ if (SvTAINTED(sstr))
+ SvTAINT(dstr);
return;
}
if (SvPVX(dstr)) {
else
(void)SvOK_off(dstr);
}
- SvTAINT(dstr);
+ if (SvTAINTED(sstr))
+ SvTAINT(dstr);
}
/*
STRLEN
Perl_sv_len_utf8(pTHX_ register SV *sv)
{
- U8 *s;
- U8 *send;
- STRLEN len;
-
if (!sv)
return 0;
#ifdef NOTYET
if (SvGMAGICAL(sv))
- len = mg_length(sv);
+ return mg_length(sv);
else
#endif
- s = (U8*)SvPV(sv, len);
- send = s + len;
- len = 0;
- while (s < send) {
- s += UTF8SKIP(s);
- len++;
+ {
+ STRLEN len;
+ U8 *s = (U8*)SvPV(sv, len);
+
+ return Perl_utf8_length(aTHX_ s, s + len);
}
- return len;
}
void
pv2 = SvPV(sv2, cur2);
/* do not utf8ize the comparands as a side-effect */
- if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE && 0) {
+ if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE) {
if (SvUTF8(sv1)) {
pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
pv2tmp = TRUE;
}
if (GvHV(gv) && !HvNAME(GvHV(gv))) {
hv_clear(GvHV(gv));
-#if !defined( VMS) && !defined(EPOC) /* VMS has no environ array */
+#ifdef USE_ENVIRON_ARRAY
if (gv == PL_envgv)
environ[0] = Nullch;
#endif
bool has_precis = FALSE;
STRLEN precis = 0;
bool is_utf = FALSE;
-
+
char esignbuf[4];
U8 utf8buf[UTF8_MAXLEN];
STRLEN esignlen = 0;
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) {
/* 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':
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 */
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++;
}
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);
}
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;
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) {
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;
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;
}
}
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;
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;
}
}
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;
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') {
*--eptr = '#';
*--eptr = '%';
- {
- STORE_NUMERIC_STANDARD_SET_LOCAL();
-#ifdef USE_LOCALE_NUMERIC
- if (!was_standard && maybe_tainted)
- *maybe_tainted = TRUE;
-#endif
- (void)sprintf(PL_efloatbuf, eptr, nv);
- RESTORE_NUMERIC_STANDARD();
- }
+ (void)sprintf(PL_efloatbuf, eptr, nv);
eptr = PL_efloatbuf;
elen = strlen(PL_efloatbuf);
#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 */
ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
if (!specialWARN(PL_compiling.cop_warnings))
PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
+ if (!specialCopIO(PL_compiling.cop_io))
+ PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io);
PL_curcop = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
/* pseudo environmental stuff */
projects / p5sagit/p5-mst-13.2.git / blobdiff