* has to be allocated and SvPVX(sstr) has to be freed.
*/
+ /* Whichever path we take through the next code, we want this true,
+ and doing it now facilitates the COW check. */
+ (void)SvPOK_only(dstr);
+
if (
#ifdef PERL_COPY_ON_WRITE
(sflags & (SVf_FAKE | SVf_READONLY)) != (SVf_FAKE | SVf_READONLY)
!(PL_op && PL_op->op_type == OP_AASSIGN))
#ifdef PERL_COPY_ON_WRITE
&& !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
+ && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
&& SvTYPE(sstr) >= SVt_PVIV)
#endif
) {
Move(SvPVX(sstr),SvPVX(dstr),len,char);
SvCUR_set(dstr, len);
*SvEND(dstr) = '\0';
- (void)SvPOK_only(dstr);
} else {
/* If PERL_COPY_ON_WRITE is not defined, then isSwipe will always
be true in here. */
else if (SvLEN(dstr))
Safefree(SvPVX(dstr));
}
- (void)SvPOK_only(dstr);
#ifdef PERL_COPY_ON_WRITE
if (!isSwipe) {
if (SvREADONLY(sv)) {
if (SvFAKE(sv)) {
char *pvx = SvPVX(sv);
+ int is_utf8 = SvUTF8(sv);
STRLEN len = SvCUR(sv);
U32 hash = SvUVX(sv);
SvFAKE_off(sv);
SvREADONLY_off(sv);
+ SvPVX(sv) = 0;
+ SvLEN(sv) = 0;
SvGROW(sv, len + 1);
Move(pvx,SvPVX(sv),len,char);
*SvEND(sv) = '\0';
- unsharepvn(pvx, SvUTF8(sv) ? -(I32)len : len, hash);
+ unsharepvn(pvx, is_utf8 ? -(I32)len : len, hash);
}
else if (IN_PERL_RUNTIME)
Perl_croak(aTHX_ PL_no_modify);
bool found = FALSE;
if (SvMAGICAL(sv) && !SvREADONLY(sv)) {
- if (!*mgp) {
- sv_magic(sv, 0, PERL_MAGIC_utf8, 0, 0);
- *mgp = mg_find(sv, PERL_MAGIC_utf8);
- }
+ if (!*mgp)
+ *mgp = sv_magicext(sv, 0, PERL_MAGIC_utf8, &PL_vtbl_utf8, 0, 0);
assert(*mgp);
if ((*mgp)->mg_ptr)
/* Update the cache. */
(*cachep)[i] = (STRLEN)uoff;
(*cachep)[i+1] = p - start;
+
+ /* Drop the stale "length" cache */
+ if (i == 0) {
+ (*cachep)[2] = 0;
+ (*cachep)[3] = 0;
+ }
found = TRUE;
}
}
#define EXPECT_NUMBER(pattern, var) (var = S_expect_number(aTHX_ &pattern))
+static char *
+F0convert(NV nv, char *endbuf, STRLEN *len)
+{
+ int neg = nv < 0;
+ UV uv;
+ char *p = endbuf;
+
+ if (neg)
+ nv = -nv;
+ if (nv < UV_MAX) {
+ nv += 0.5;
+ uv = nv;
+ if (uv & 1 && uv == nv)
+ uv--; /* Round to even */
+ do {
+ unsigned dig = uv % 10;
+ *--p = '0' + dig;
+ } while (uv /= 10);
+ if (neg)
+ *--p = '-';
+ *len = endbuf - p;
+ return p;
+ }
+ return Nullch;
+}
+
+
/*
=for apidoc sv_vcatpvfn
bool has_utf8; /* has the result utf8? */
bool pat_utf8; /* the pattern is in utf8? */
SV *nsv = Nullsv;
+ /* Times 4: a decimal digit takes more than 3 binary digits.
+ * NV_DIG: mantissa takes than many decimal digits.
+ * Plus 32: Playing safe. */
+ char ebuf[IV_DIG * 4 + NV_DIG + 32];
+ /* large enough for "%#.#f" --chip */
+ /* what about long double NVs? --jhi */
has_utf8 = pat_utf8 = DO_UTF8(sv);
}
}
+#ifndef USE_LONG_DOUBLE
+ /* special-case "%.<number>[gf]" */
+ if ( patlen <= 5 && pat[0] == '%' && pat[1] == '.'
+ && (pat[patlen-1] == 'g' || pat[patlen-1] == 'f') ) {
+ unsigned digits = 0;
+ const char *pp;
+
+ pp = pat + 2;
+ while (*pp >= '0' && *pp <= '9')
+ digits = 10 * digits + (*pp++ - '0');
+ if (pp - pat == patlen - 1) {
+ NV nv;
+
+ if (args)
+ nv = (NV)va_arg(*args, double);
+ else if (svix < svmax)
+ nv = SvNV(*svargs);
+ else
+ return;
+ if (*pp == 'g') {
+ if (digits < sizeof(ebuf) - NV_DIG - 10) { /* 0, point, slack */
+ Gconvert(nv, (int)digits, 0, ebuf);
+ sv_catpv(sv, ebuf);
+ if (*ebuf) /* May return an empty string for digits==0 */
+ return;
+ }
+ } else if (!digits) {
+ STRLEN l;
+
+ if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
+ sv_catpvn(sv, p, l);
+ return;
+ }
+ }
+ }
+ }
+#endif /* !USE_LONG_DOUBLE */
+
if (!args && svix < svmax && DO_UTF8(*svargs))
has_utf8 = TRUE;
char *eptr = Nullch;
STRLEN elen = 0;
- /* Times 4: a decimal digit takes more than 3 binary digits.
- * NV_DIG: mantissa takes than many decimal digits.
- * Plus 32: Playing safe. */
- char ebuf[IV_DIG * 4 + NV_DIG + 32];
- /* large enough for "%#.#f" --chip */
- /* what about long double NVs? --jhi */
-
SV *vecsv = Nullsv;
U8 *vecstr = Null(U8*);
STRLEN veclen = 0;
PL_efloatbuf[0] = '\0';
}
+ if ( !(width || left || plus || alt) && fill != '0'
+ && has_precis && intsize != 'q' ) { /* Shortcuts */
+ if ( c == 'g') {
+ Gconvert((NV)nv, (int)precis, 0, PL_efloatbuf);
+ if (*PL_efloatbuf) /* May return an empty string for digits==0 */
+ goto float_converted;
+ } else if ( c == 'f' && !precis) {
+ if ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen)))
+ break;
+ }
+ }
eptr = ebuf + sizeof ebuf;
*--eptr = '\0';
*--eptr = c;
#else
(void)sprintf(PL_efloatbuf, eptr, nv);
#endif
+ float_converted:
eptr = PL_efloatbuf;
elen = strlen(PL_efloatbuf);
break;
PL_debug = proto_perl->Idebug;
#ifdef USE_REENTRANT_API
-#ifdef DEBUGGING
- PERL_SET_CONTEXT(proto_perl);
-#endif
+ /* XXX: things like -Dm will segfault here in perlio, but doing
+ * PERL_SET_CONTEXT(proto_perl);
+ * breaks too many other things
+ */
Perl_reentrant_init(aTHX);
#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff