s++; if (*s != 'I' && *s != 'i') return 0;
s++; if (*s != 'T' && *s != 't') return 0;
s++; if (*s != 'Y' && *s != 'y') return 0;
+ s++;
}
sawinf = 1;
}
Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
{
if (SvPOK(sv) && SvUTF8(sv)) {
- char *c = SvPVX(sv);
- STRLEN len = SvCUR(sv) + 1; /* include trailing NUL */
- if (!utf8_to_bytes((U8*)c, &len)) {
- if (fail_ok)
- return FALSE;
- else {
- if (PL_op)
- Perl_croak(aTHX_ "Wide character in %s",
- PL_op_desc[PL_op->op_type]);
- else
- Perl_croak(aTHX_ "Wide character");
+ if (SvCUR(sv)) {
+ char *c = SvPVX(sv);
+ STRLEN len = SvCUR(sv);
+
+ if (!utf8_to_bytes((U8*)c, &len)) {
+ if (fail_ok)
+ return FALSE;
+ 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;
}
- SvCUR(sv) = len - 1;
SvUTF8_off(sv);
}
+
return TRUE;
}
if (SvTEMP(sstr) && /* slated for free anyway? */
SvREFCNT(sstr) == 1 && /* and no other references to it? */
!(sflags & SVf_OOK) && /* and not involved in OOK hack? */
- SvLEN(sstr)) /* and really is a string */
+ SvLEN(sstr) && /* and really is a string */
+ !(PL_op && PL_op->op_type == OP_AASSIGN)) /* and won't be needed again, potentially */
{
if (SvPVX(dstr)) { /* we know that dtype >= SVt_PV */
if (SvOOK(dstr)) {
Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
{
register char *dptr;
- assert(len >= 0); /* STRLEN is probably unsigned, so this may
- elicit a warning, but it won't hurt. */
+ {
+ /* len is STRLEN which is unsigned, need to copy to signed */
+ IV iv = len;
+ assert(iv >= 0);
+ }
SV_CHECK_THINKFIRST(sv);
if (!ptr) {
(void)SvOK_off(sv);
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
}
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
*--eptr = '#';
*--eptr = '%';
+ /* No taint. Otherwise we are in the strange situation
+ * where printf() taints but print($float) doesn't.
+ * --jhi */
(void)sprintf(PL_efloatbuf, eptr, nv);
eptr = PL_efloatbuf;
av = (AV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = av_dup(av);
break;
+ case SAVEt_PADSV:
+ longval = (long)POPLONG(ss,ix);
+ TOPLONG(nss,ix) = longval;
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup(sv);
+ break;
default:
Perl_croak(aTHX_ "panic: ss_dup inconsistency");
}
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 */