U8 * s = (U8 *) SvPVX_const(sv);
U8 * e = (U8 *) SvEND(sv);
U8 *t = s;
- STRLEN two_byte_count = 0;
+ STRLEN two_byte_count;
- if (flags & SV_FORCE_UTF8_UPGRADE) goto must_be_utf8;
-
- /* See if really will need to convert to utf8. We mustn't rely on our
- * incoming SV being well formed and having a trailing '\0', as certain
- * code in pp_formline can send us partially built SVs. */
-
- while (t < e) {
- const U8 ch = *t++;
- if (NATIVE_BYTE_IS_INVARIANT(ch)) continue;
-
- t--; /* t already incremented; re-point to first variant */
- two_byte_count = 1;
- goto must_be_utf8;
- }
+ if (flags & SV_FORCE_UTF8_UPGRADE) {
+ two_byte_count = 0;
+ }
+ else {
+ if (is_utf8_invariant_string_loc(s, SvCUR(sv), (const U8 **) &t)) {
- /* utf8 conversion not needed because all are invariants. Mark as
- * UTF-8 even if no variant - saves scanning loop */
- SvUTF8_on(sv);
- if (extra) SvGROW(sv, SvCUR(sv) + extra);
- return SvCUR(sv);
+ /* utf8 conversion not needed because all are invariants. Mark
+ * as UTF-8 even if no variant - saves scanning loop */
+ SvUTF8_on(sv);
+ if (extra) SvGROW(sv, SvCUR(sv) + extra);
+ return SvCUR(sv);
+ }
- must_be_utf8:
+ /* Here, there is at least one variant, and t points to the first
+ * one */
+ two_byte_count = 1;
+ }
- /* Here, the string should be converted to utf8, either because of an
- * input flag (two_byte_count = 0), or because a character that
- * requires 2 bytes was found (two_byte_count = 1). t points either to
- * the beginning of the string (if we didn't examine anything), or to
- * the first variant. In either case, everything from s to t - 1 will
- * occupy only 1 byte each on output.
+ /* Note that the incoming SV may not have a trailing '\0', as certain
+ * code in pp_formline can send us partially built SVs.
+ *
+ * Here, the string should be converted to utf8, either because of an
+ * input flag (which causes two_byte_count to be set to 0), or because
+ * a character that requires 2 bytes was found (two_byte_count = 1). t
+ * points either to the beginning of the string (if we didn't examine
+ * anything), or to the first variant. In either case, everything from
+ * s to t - 1 will occupy only 1 byte each on output.
*
* There are two main ways to convert. One is to create a new string
* and go through the input starting from the beginning, appending each
* from s to t - 1 is invariant, the destination can be initialized
* with these using a fast memory copy
*
- * The other way is to figure out exactly how big the string should be
+ * The other way is to figure out exactly how big the string should be,
* by parsing the entire input. Then you don't have to make it big
* enough to handle the worst possible case, and more importantly, if
* the string you already have is large enough, you don't have to
* value. We go backwards through the string, converting until we
* get to the position we are at now, and then stop. If this
* position is far enough along in the string, this method is
- * faster than the other method. If the memory copy were the same
- * speed as the byte-by-byte loop, that position would be about
- * half-way, as at the half-way mark, parsing to the end and back
- * is one complete string's parse, the same amount as starting
- * over and going all the way through. Actually, it would be
- * somewhat less than half-way, as it's faster to just count bytes
- * than to also copy, and we don't have the overhead of allocating
- * a new string, changing the scalar to use it, and freeing the
- * existing one. But if the memory copy is fast, the break-even
- * point is somewhere after half way. The counting loop could be
- * sped up by vectorization, etc, to move the break-even point
- * further towards the beginning.
+ * faster than the first method above. If the memory copy were
+ * the same speed as the byte-by-byte loop, that position would be
+ * about half-way, as at the half-way mark, parsing to the end and
+ * back is one complete string's parse, the same amount as
+ * starting over and going all the way through. Actually, it
+ * would be somewhat less than half-way, as it's faster to just
+ * count bytes than to also copy, and we don't have the overhead
+ * of allocating a new string, changing the scalar to use it, and
+ * freeing the existing one. But if the memory copy is fast, the
+ * break-even point is somewhere after half way. The counting
+ * loop could be sped up by vectorization, etc, to move the
+ * break-even point further towards the beginning.
* 2) if the string doesn't have enough space to handle the converted
* value. A new string will have to be allocated, and one might
* as well, given that, start from the beginning doing the first
void
Perl_sv_vsetpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
- va_list *const args, SV **const svargs, const Size_t svmax, bool *const maybe_tainted)
+ va_list *const args, SV **const svargs, const Size_t sv_count, bool *const maybe_tainted)
{
PERL_ARGS_ASSERT_SV_VSETPVFN;
SvPVCLEAR(sv);
- sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, 0);
+ sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, sv_count, maybe_tainted, 0);
+}
+
+
+/* simplified inline Perl_sv_catpvn_nomg() when you know the SV's SvPOK */
+
+PERL_STATIC_INLINE void
+S_sv_catpvn_simple(pTHX_ SV *const sv, const char* const buf, const STRLEN len)
+{
+ STRLEN const need = len + SvCUR(sv) + 1;
+ char *end;
+
+ /* can't wrap as both len and SvCUR() are allocated in
+ * memory and together can't consume all the address space
+ */
+ assert(need > len);
+
+ assert(SvPOK(sv));
+ SvGROW(sv, need);
+ end = SvEND(sv);
+ Copy(buf, end, len, char);
+ end += len;
+ *end = '\0';
+ SvCUR_set(sv, need - 1);
}
*/
STATIC STRLEN
-S_expect_number(pTHX_ char **const pattern)
+S_expect_number(pTHX_ const char **const pattern)
{
STRLEN var;
void
Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
- va_list *const args, SV **const svargs, const Size_t svmax, bool *const maybe_tainted)
+ va_list *const args, SV **const svargs, const Size_t sv_count, bool *const maybe_tainted)
{
PERL_ARGS_ASSERT_SV_VCATPVFN;
- sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, SV_GMAGIC|SV_SMAGIC);
+ sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, sv_count, maybe_tainted, SV_GMAGIC|SV_SMAGIC);
}
#endif
const U8* vmaxend = vhex + HEXTRACTSIZE;
+
+ assert(HEXTRACTSIZE <= VHEX_SIZE);
+
PERL_UNUSED_VAR(ix); /* might happen */
(void)Perl_frexp(PERL_ABS(nv), exponent);
*subnormal = FALSE;
const U8* nvp = (const U8*)(&nv);
HEXTRACT_GET_SUBNORMAL(nv);
HEXTRACT_IMPLICIT_BIT(nv);
-# undef HEXTRACT_HAS_TOP_NYBBLE
+# undef HEXTRACT_HAS_TOP_NYBBLE
HEXTRACT_BYTES_LE(13, 0);
# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
/* Used in e.g. Solaris Sparc and HP-UX PA-RISC, e.g. -0.1L:
const U8* nvp = (const U8*)(&nv);
HEXTRACT_GET_SUBNORMAL(nv);
HEXTRACT_IMPLICIT_BIT(nv);
-# undef HEXTRACT_HAS_TOP_NYBBLE
+# undef HEXTRACT_HAS_TOP_NYBBLE
HEXTRACT_BYTES_BE(2, 15);
# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
/* x86 80-bit "extended precision", 64 bits of mantissa / fraction /
# define HEXTRACT_FALLBACK
# endif
#endif /* #if defined(USE_LONG_DOUBLE) && (NVSIZE > DOUBLESIZE) #else */
-# ifdef HEXTRACT_FALLBACK
+
+#ifdef HEXTRACT_FALLBACK
HEXTRACT_GET_SUBNORMAL(nv);
-# undef HEXTRACT_HAS_TOP_NYBBLE /* Meaningless, but consistent. */
+# undef HEXTRACT_HAS_TOP_NYBBLE /* Meaningless, but consistent. */
/* The fallback is used for the double-double format, and
* for unknown long double formats, and for unknown double
* formats, or in general unknown NV formats. */
v++;
}
}
-# endif
+#endif
}
/* Croak for various reasons: if the output pointer escaped the
* output buffer, if the extraction index escaped the extraction
* same name within Perl_sv_vcatpvfn_flags().
*
* It assumes the caller has already done STORE_LC_NUMERIC_SET_TO_NEEDED();
+ *
+ * It requires the caller to make buf large enough.
*/
static STRLEN
}
elen = p - buf;
+
+ /* sanity checks */
+ if (elen >= bufsize || width >= bufsize)
+ /* diag_listed_as: Hexadecimal float: internal error (%s) */
+ Perl_croak(aTHX_ "Hexadecimal float: internal error (overflow)");
+
elen += my_snprintf(p, bufsize - elen,
"%c%+d", lower ? 'p' : 'P',
exponent);
void
Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
- va_list *const args, SV **const svargs, const Size_t svmax, bool *const maybe_tainted,
+ va_list *const args, SV **const svargs, const Size_t sv_count, bool *const maybe_tainted,
const U32 flags)
{
- char *p;
- char *q;
+ const char *fmtstart; /* character following the current '%' */
+ const char *q; /* current position within format */
const char *patend;
STRLEN origlen;
Size_t svix = 0;
SV *argsv = NULL;
bool has_utf8 = DO_UTF8(sv); /* has the result utf8? */
const bool pat_utf8 = has_utf8; /* the pattern is in utf8? */
- SV *nsv = NULL;
/* Times 4: a decimal digit takes more than 3 binary digits.
* NV_DIG: mantissa takes than many decimal digits.
* Plus 32: Playing safe. */
* should be fixed */
assert(pat[patlen] == '\0');
- /* special-case "", "%s", and "%-p" (SVf - see below) */
- if (patlen == 0) {
- if (svmax && ckWARN(WARN_REDUNDANT))
- Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
- PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
- return;
- }
- if (patlen == 2 && pat[0] == '%' && pat[1] == 's') {
- if (svmax > 1 && ckWARN(WARN_REDUNDANT))
- Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
- PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
- if (args) {
- const char * const s = va_arg(*args, char*);
- sv_catpv_nomg(sv, s ? s : nullstr);
- }
- else if (svix < svmax) {
- /* we want get magic on the source but not the target. sv_catsv can't do that, though */
- SvGETMAGIC(*svargs);
- sv_catsv_nomg(sv, *svargs);
- }
- else
- S_warn_vcatpvfn_missing_argument(aTHX);
- return;
- }
- if (args && patlen == 3 && pat[0] == '%' &&
- pat[1] == '-' && pat[2] == 'p') {
- if (svmax > 1 && ckWARN(WARN_REDUNDANT))
- Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
- PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
- argsv = MUTABLE_SV(va_arg(*args, void*));
- sv_catsv_nomg(sv, argsv);
+ /* Special-case "", "%s", "%-p" (SVf - see below) and "%.0f".
+ * In each case, if there isn't the correct number of args, instead
+ * fall through to the main code to handle the issuing of any
+ * warnings etc.
+ */
+
+ if (patlen == 0 && (args || sv_count == 0))
return;
- }
-#if !defined(USE_LONG_DOUBLE) && !defined(USE_QUADMATH)
- /* special-case "%.0f" */
- if ( !args
- && patlen == 4
- && pat[0] == '%' && pat[1] == '.' && pat[2] == '0' && pat[3] == 'f'
- && svmax > 0)
- {
- const NV nv = SvNV(*svargs);
- if (LIKELY(!Perl_isinfnan(nv))) {
- STRLEN l;
- char *p;
+ if (patlen <= 4 && pat[0] == '%' && (args || sv_count == 1)) {
- if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
- sv_catpvn_nomg(sv, p, l);
+ /* "%s" */
+ if (patlen == 2 && pat[1] == 's') {
+ if (args) {
+ const char * const s = va_arg(*args, char*);
+ sv_catpv_nomg(sv, s ? s : nullstr);
+ }
+ else {
+ /* we want get magic on the source but not the target.
+ * sv_catsv can't do that, though */
+ SvGETMAGIC(*svargs);
+ sv_catsv_nomg(sv, *svargs);
+ }
+ return;
+ }
+
+ /* "%-p" */
+ if (args) {
+ if (patlen == 3 && pat[1] == '-' && pat[2] == 'p') {
+ SV *asv = MUTABLE_SV(va_arg(*args, void*));
+ sv_catsv_nomg(sv, asv);
return;
}
- }
- }
+ }
+#if !defined(USE_LONG_DOUBLE) && !defined(USE_QUADMATH)
+ /* special-case "%.0f" */
+ else if ( patlen == 4
+ && pat[1] == '.' && pat[2] == '0' && pat[3] == 'f')
+ {
+ const NV nv = SvNV(*svargs);
+ if (LIKELY(!Perl_isinfnan(nv))) {
+ STRLEN l;
+ char *p;
+
+ if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
+ sv_catpvn_nomg(sv, p, l);
+ return;
+ }
+ }
+ }
#endif /* !USE_LONG_DOUBLE */
+ }
- patend = (char*)pat + patlen;
- for (p = (char*)pat; p < patend; p = q) {
+ patend = (char*)pat + patlen;
+ for (fmtstart = pat; fmtstart < patend; fmtstart = q) {
char intsize = 0; /* size qualifier in "%hi..." etc */
bool alt = FALSE; /* has "%#..." */
bool left = FALSE; /* has "%-..." */
STRLEN width = 0; /* value of "%NNN..." */
bool has_precis = FALSE; /* has "%.NNN..." */
STRLEN precis = 0; /* value of "%.NNN..." */
- bool used_explicit_ix = FALSE;/* has "%$n..." */
int base = 0; /* base to print in, e.g. 8 for %o */
UV uv = 0; /* the value to print of int-ish args */
const char *eptr = NULL; /* the address of the element string */
STRLEN elen = 0; /* the length of the element string */
- const char *fmtstart; /* start of current format (the '%') */
char c; /* the actual format ('d', s' etc) */
/* echo everything up to the next format specification */
- for (q = p; q < patend && *q != '%'; ++q) ;
- if (q > p) {
- if (has_utf8 && !pat_utf8)
- sv_catpvn_nomg_utf8_upgrade(sv, p, q - p, nsv);
+ for (q = fmtstart; q < patend && *q != '%'; ++q)
+ {};
+
+ if (q > fmtstart) {
+ if (has_utf8 && !pat_utf8) {
+ /* upgrade and copy the bytes of fmtstart..q-1 to utf8 on
+ * the fly */
+ const char *p;
+ char *dst;
+ STRLEN need = SvCUR(sv) + (q - fmtstart) + 1;
+
+ for (p = fmtstart; p < q; p++)
+ if (!NATIVE_BYTE_IS_INVARIANT(*p))
+ need++;
+ SvGROW(sv, need);
+
+ dst = SvEND(sv);
+ for (p = fmtstart; p < q; p++)
+ append_utf8_from_native_byte((U8)*p, (U8**)&dst);
+ *dst = '\0';
+ SvCUR_set(sv, need - 1);
+ }
else
- sv_catpvn_nomg(sv, p, q - p);
- p = q;
+ S_sv_catpvn_simple(aTHX_ sv, fmtstart, q - fmtstart);
}
if (q++ >= patend)
break;
- fmtstart = q;
+ fmtstart = q; /* fmtstart is char following the '%' */
/*
We allow format specification elements in this order:
++q;
efix = (Size_t)width;
width = 0;
- used_explicit_ix = TRUE;
+ no_redundant_warning = TRUE;
} else {
goto gotwidth;
}
if (args)
Perl_croak_nocontext(
"Cannot yet reorder sv_catpvfn() arguments from va_list");
- used_explicit_ix = TRUE;
+ no_redundant_warning = TRUE;
} else
goto unknown;
}
vecsv = va_arg(*args, SV*);
else {
ix = ix ? ix - 1 : svix++;
- vecsv = ix < svmax ? svargs[ix]
+ vecsv = ix < sv_count ? svargs[ix]
: (arg_missing = TRUE, &PL_sv_no);
}
dotstr = SvPV_const(vecsv, dotstrlen);
i = va_arg(*args, int);
else {
ix = ix ? ix - 1 : svix++;
- sv = (ix < svmax) ? svargs[ix]
+ sv = (ix < sv_count) ? svargs[ix]
: (arg_missing = TRUE, (SV*)NULL);
}
width = S_sprintf_arg_num_val(aTHX_ args, i, sv, &left);
if (args)
Perl_croak_nocontext(
"Cannot yet reorder sv_catpvfn() arguments from va_list");
- used_explicit_ix = TRUE;
+ no_redundant_warning = TRUE;
} else
goto unknown;
}
i = va_arg(*args, int);
else {
ix = ix ? ix - 1 : svix++;
- sv = (ix < svmax) ? svargs[ix]
+ sv = (ix < sv_count) ? svargs[ix]
: (arg_missing = TRUE, (SV*)NULL);
}
precis = S_sprintf_arg_num_val(aTHX_ args, i, sv, &neg);
if (!args) {
efix = efix ? efix - 1 : svix++;
- argsv = efix < svmax ? svargs[efix]
+ argsv = efix < sv_count ? svargs[efix]
: (arg_missing = TRUE, &PL_sv_no);
}
/* not %*p or %*1$p - any width was explicit */
&& q[-2] != '*'
&& q[-2] != '$'
- && !used_explicit_ix
) {
if (left) { /* %-p (SVf), %-NNNp */
if (width) {
* over the individual characters of a vector arg */
vector:
if (!veclen)
- goto donevalidconversion;
+ goto done_valid_conversion;
if (vec_utf8)
uv = utf8n_to_uvchr(vecstr, veclen, &ulen,
UTF8_ALLOW_ANYUV);
}
}
else {
- IV tiv = SvIV_nomg(argsv); /* work around GCC bug #13488 */
+ /* assign to tiv then cast to iv to work around
+ * 2003 GCC cast bug (gnu.org bugzilla #13488) */
+ IV tiv = SvIV_nomg(argsv);
switch (intsize) {
case 'c': iv = (char)tiv; break;
case 'h': iv = (short)tiv; break;
}
}
else {
- UV tuv = SvUV_nomg(argsv); /* work around GCC bug #13488 */
+ /* assign to tiv then cast to iv to work around
+ * 2003 GCC cast bug (gnu.org bugzilla #13488) */
+ UV tuv = SvUV_nomg(argsv);
switch (intsize) {
case 'c': uv = (unsigned char)tuv; break;
case 'h': uv = (unsigned short)tuv; break;
do_integer:
{
char *ptr = ebuf + sizeof ebuf;
- bool tempalt = uv ? alt : FALSE; /* Vectors can't change alt */
unsigned dig;
zeros = 0;
switch (base) {
case 16:
- p = (char *)((c == 'X') ? PL_hexdigit + 16 : PL_hexdigit);
- do {
- dig = uv & 15;
- *--ptr = p[dig];
- } while (uv >>= 4);
- if (tempalt) {
- esignbuf[esignlen++] = '0';
- esignbuf[esignlen++] = c; /* 'x' or 'X' */
- }
- break;
+ {
+ const char * const p =
+ (c == 'X') ? PL_hexdigit + 16 : PL_hexdigit;
+
+ do {
+ dig = uv & 15;
+ *--ptr = p[dig];
+ } while (uv >>= 4);
+ if (alt && *ptr != '0') {
+ esignbuf[esignlen++] = '0';
+ esignbuf[esignlen++] = c; /* 'x' or 'X' */
+ }
+ break;
+ }
case 8:
do {
dig = uv & 7;
dig = uv & 1;
*--ptr = '0' + dig;
} while (uv >>= 1);
- if (tempalt) {
+ if (alt && *ptr != '0') {
esignbuf[esignlen++] = '0';
esignbuf[esignlen++] = c; /* 'b' or 'B' */
}
case 'a': case 'A':
{
- STRLEN radix_len; /* SvCUR(PL_numeric_radix_sv) */
STRLEN float_need; /* what PL_efloatsize needs to become */
bool hexfp; /* hexadecimal floating point? */
&& intsize != 'q'
&& ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen)))
)
- goto float_concat_no_utf8;
+ goto float_concat;
/* Determine the buffer size needed for the various
* floating-point formats.
* First, here are the constant bits. For ease of calculation
* we over-estimate the needed buffer size, for example by
* assuming all formats have an exponent and a leading 0x1.
+ *
+ * Also for production use, add a little extra overhead for
+ * safety's sake. Under debugging don't, as it means we're
+ * more likely to quickly spot issues during development.
*/
float_need = 1 /* possible unary minus */
+ 4 /* "0x1" plus very unlikely carry */
+ + 1 /* default radix point '.' */
+ 2 /* "e-", "p+" etc */
+ 6 /* exponent: up to 16383 (quad fp) */
+#ifndef DEBUGGING
+ + 20 /* safety net */
+#endif
+ 1; /* \0 */
/* determine the radix point len, e.g. length(".") in "1.2" */
- radix_len = 1; /* assume '.' */
#ifdef USE_LOCALE_NUMERIC
/* note that we may either explicitly use PL_numeric_radix_sv
* below, or implicitly, via an snprintf() variant.
if (PL_numeric_radix_sv) {
assert(IN_LC(LC_NUMERIC));
- radix_len = SvCUR(PL_numeric_radix_sv);
- /* note that this will convert the output to utf8 even if
- * if the radix point didn't get output */
- is_utf8 = SvUTF8(PL_numeric_radix_sv);
+ /* this can't wrap unless PL_numeric_radix_sv is a string
+ * consuming virtually all the 32-bit or 64-bit address
+ * space
+ */
+ float_need += (SvCUR(PL_numeric_radix_sv) - 1);
+
+ /* floating-point formats only get utf8 if the radix point
+ * is utf8. All other characters in the string are < 128
+ * and so can be safely appended to both a non-utf8 and utf8
+ * string as-is.
+ * Note that this will convert the output to utf8 even if
+ * the radix point didn't get output.
+ */
+ if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) {
+ sv_utf8_upgrade(sv);
+ has_utf8 = TRUE;
+ }
}
#endif
- /* this can't wrap unless PL_numeric_radix_sv is a string
- * consuming virtually all the 32-bit or 64-bit address space
- */
- float_need += radix_len;
hexfp = FALSE;
if (i > 0) {
digits = BIT_DIGITS(i);
- if (float_need >= ((STRLEN)~0) - digits)
- croak_memory_wrap();
+ /* this can't overflow. 'digits' will only be a few
+ * thousand even for the largest floating-point types.
+ * And up until now float_need is just some small
+ * constants plus radix len, which can't be in
+ * overflow territory unless the radix SV is consuming
+ * over 1/2 the address space */
+ assert(float_need < ((STRLEN)~0) - digits);
float_need += digits;
}
}
#else
NVSIZE * 2; /* 2 hexdigits for each byte */
#endif
- if (float_need >= ((STRLEN)~0) - digits)
- croak_memory_wrap();
+ /* see "this can't overflow" comment above */
+ assert(float_need < ((STRLEN)~0) - digits);
float_need += digits;
}
}
{
STRLEN pr = has_precis ? precis : 6; /* known default */
+ /* this probably can't wrap, since precis is limited
+ * to 1/4 address space size, but better safe than sorry
+ */
if (float_need >= ((STRLEN)~0) - pr)
croak_memory_wrap();
float_need += pr;
if (float_need < width)
float_need = width;
-/* We should have correctly calculated (or indeed over-estimated) the
- * buffer size, but you never know what strange floating-point systems
- * there are out there. So for production use, add a little extra overhead.
- * Under debugging don't, as it means we more more likely to quickly spot
- * issues during development.
- */
-#ifndef DEBUGGING
- if (float_need >= ((STRLEN)~0) - 20)
- croak_memory_wrap();
- float_need += 20; /* safety fudge factor */
-#endif
-
if (PL_efloatsize < float_need) {
Safefree(PL_efloatbuf);
PL_efloatsize = float_need;
* loop which handles appending eptr to sv, and do our own
* stripped-down version */
- /* floating-point formats only get is_utf8 if the radix point
- * is utf8. All other characters in the string are < 128
- * and so can be safely appended to both a non-utf8 and utf8
- * string as-is.
- */
- if (is_utf8 && !has_utf8) {
- sv_utf8_upgrade(sv);
- has_utf8 = TRUE;
- }
-
- float_concat_no_utf8:
-
assert(!zeros);
assert(!esignlen);
assert(elen);
assert(elen >= width);
+ S_sv_catpvn_simple(aTHX_ sv, eptr, elen);
- {
- /* unrolled Perl_sv_catpvn */
- STRLEN need = elen + SvCUR(sv) + 1;
- char *end;
- /* can't wrap as both elen and SvCUR() are allocated in
- * memory and together can't consume all the address space
- */
- assert(need > elen);
- SvGROW(sv, need);
- end = SvEND(sv);
- Copy(eptr, end, elen, char);
- end += elen;
- *end = '\0';
- SvCUR_set(sv, need - 1);
- }
-
- goto donevalidconversion;
+ goto done_valid_conversion;
}
/* SPECIAL */
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
sv_setuv_mg(argsv, has_utf8 ? (UV)sv_len_utf8(sv) : (UV)len);
}
- goto donevalidconversion;
+ goto done_valid_conversion;
}
/* UNKNOWN */
/* mangled format: output the '%', then continue from the
* character following that */
- sv_catpvn_nomg(sv, p, 1);
- q = p + 1;
+ sv_catpvn_nomg(sv, fmtstart-1, 1);
+ q = fmtstart;
svix = osvix;
+ /* Any "redundant arg" warning from now onwards will probably
+ * just be misleading, so don't bother. */
+ no_redundant_warning = TRUE;
continue; /* not "break" */
}
{
STRLEN need, have, gap;
+ STRLEN i;
+ char *s;
/* signed value that's wrapped? */
assert(elen <= ((~(STRLEN)0) >> 1));
- /* Most of these length vars can range to any value if
- * supplied with a hostile format and/or args. So check every
- * addition for possible overflow. In reality some of these
- * values are interdependent so these checks are slightly
- * redundant. But its easier to be certain this way.
- */
-
- have = elen;
-
- if (have >= (((STRLEN)~0) - zeros))
- croak_memory_wrap();
- have += zeros;
+ /* if zeros is non-zero, then it represents filler between
+ * elen and precis. So adding elen and zeros together will
+ * always be <= precis, and the addition can never wrap */
+ assert(!zeros || (precis > elen && precis - elen == zeros));
+ have = elen + zeros;
if (have >= (((STRLEN)~0) - esignlen))
croak_memory_wrap();
SvGROW(sv, need);
- p = SvEND(sv);
- if (esignlen && fill) {
- STRLEN i;
- for (i = 0; i < esignlen; i++)
- *p++ = esignbuf[i];
- }
- if (gap && !left) {
- memset(p, (fill ? '0' : ' '), gap);
- p += gap;
- }
- if (esignlen && !fill) {
- STRLEN i;
+ s = SvEND(sv);
+
+ if (left) {
for (i = 0; i < esignlen; i++)
- *p++ = esignbuf[i];
- }
- if (zeros) {
- STRLEN i;
+ *s++ = esignbuf[i];
for (i = zeros; i; i--)
- *p++ = '0';
+ *s++ = '0';
+ Copy(eptr, s, elen, char);
+ s += elen;
+ for (i = gap; i; i--)
+ *s++ = ' ';
}
- if (elen) {
- Copy(eptr, p, elen, char);
- p += elen;
- }
- if (gap && left) {
- memset(p, ' ', gap);
- p += gap;
+ else {
+ if (fill) {
+ for (i = 0; i < esignlen; i++)
+ *s++ = esignbuf[i];
+ assert(!zeros);
+ zeros = gap;
+ }
+ else {
+ for (i = gap; i; i--)
+ *s++ = ' ';
+ for (i = 0; i < esignlen; i++)
+ *s++ = esignbuf[i];
+ }
+
+ for (i = zeros; i; i--)
+ *s++ = '0';
+ Copy(eptr, s, elen, char);
+ s += elen;
}
+
+ *s = '\0';
+ SvCUR_set(sv, s - SvPVX_const(sv));
+
if (is_utf8)
has_utf8 = TRUE;
if (has_utf8)
SvUTF8_on(sv);
- *p = '\0';
- SvCUR_set(sv, p - SvPVX_const(sv));
}
if (vectorize && veclen) {
goto vector; /* do next iteration */
}
- donevalidconversion:
- if (used_explicit_ix)
- no_redundant_warning = TRUE;
+ done_valid_conversion:
+
if (arg_missing)
S_warn_vcatpvfn_missing_argument(aTHX);
}
/* Now that we've consumed all our printf format arguments (svix)
* do we have things left on the stack that we didn't use?
*/
- if (!no_redundant_warning && svmax >= svix + 1 && ckWARN(WARN_REDUNDANT)) {
+ if (!no_redundant_warning && sv_count >= svix + 1 && ckWARN(WARN_REDUNDANT)) {
Perl_warner(aTHX_ packWARN(WARN_REDUNDANT), "Redundant argument in %s",
PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
}
https://perl5.git.perl.org / perl5.git / blobdiff