}
-/*
-=for apidoc sv_vcatpvfn
-
-=for apidoc sv_vcatpvfn_flags
-
-Processes its arguments like C<vsprintf> and appends the formatted output
-to an SV. Uses an array of SVs if the C-style variable argument list is
-missing (C<NULL>). Argument reordering (using format specifiers like C<%2$d>
-or C<%*2$d>) is supported only when using an array of SVs; using a C-style
-C<va_list> argument list with a format string that uses argument reordering
-will yield an exception.
-
-When running with taint checks enabled, indicates via
-C<maybe_tainted> if results are untrustworthy (often due to the use of
-locales).
-
-If called as C<sv_vcatpvfn> or flags has the C<SV_GMAGIC> bit set, calls get magic.
-
-Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
-
-=cut
-*/
-
#define VECTORIZE_ARGS vecsv = va_arg(*args, SV*);\
vecstr = (U8*)SvPV_const(vecsv,veclen);\
vec_utf8 = DO_UTF8(vecsv);
* string.
* The rest of the args have the same meaning as the local vars of the
* same name within Perl_sv_vcatpvfn_flags().
+ *
+ * It assumes the caller has already done STORE_LC_NUMERIC_SET_TO_NEEDED();
*/
static STRLEN
bool subnormal = FALSE; /* IEEE 754 subnormal/denormal */
bool negative = FALSE;
STRLEN elen;
- DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
/* XXX: NaN, Inf -- though they are printed as "NaN" and "Inf".
*
#ifndef USE_LOCALE_NUMERIC
*p++ = '.';
#else
- STORE_LC_NUMERIC_SET_TO_NEEDED();
- if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
+ if (PL_numeric_radix_sv) {
STRLEN n;
const char* r = SvPV(PL_numeric_radix_sv, n);
+ assert(IN_LC(LC_NUMERIC));
Copy(r, p, n, char);
p += n;
}
else {
*p++ = '.';
}
- RESTORE_LC_NUMERIC();
#endif
}
void
-/* This function assumes that pat has the same utf8-ness as sv.
- * It's the caller's responsibility to ensure that this is so.
- */
+/*
+=for apidoc sv_vcatpvfn
+
+=for apidoc sv_vcatpvfn_flags
+
+Processes its arguments like C<vsprintf> and appends the formatted output
+to an SV. Uses an array of SVs if the C-style variable argument list is
+missing (C<NULL>). Argument reordering (using format specifiers like C<%2$d>
+or C<%*2$d>) is supported only when using an array of SVs; using a C-style
+C<va_list> argument list with a format string that uses argument reordering
+will yield an exception.
+
+When running with taint checks enabled, indicates via
+C<maybe_tainted> if results are untrustworthy (often due to the use of
+locales).
+
+If called as C<sv_vcatpvfn> or flags has the C<SV_GMAGIC> bit set, calls get magic.
+
+It assumes that pat has the same utf8-ness as sv. It's the caller's
+responsibility to ensure that this is so.
+
+Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
+
+=cut
+*/
+
Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted,
* Plus 32: Playing safe. */
char ebuf[IV_DIG * 4 + NV_DIG + 32];
bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
- bool hexfp = FALSE; /* hexadecimal floating point? */
-
+#ifdef USE_LOCALE_NUMERIC
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ bool lc_numeric_set = FALSE; /* called STORE_LC_NUMERIC_SET_TO_NEEDED? */
+#endif
PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
PERL_UNUSED_ARG(maybe_tainted);
/* no matter what, this is a string now */
(void)SvPV_force_nomg(sv, origlen);
+ /* the code that scans for flags etc following a % relies on
+ * a '\0' being present to avoid falling off the end. Ideally that
+ * should be fixed */
+ assert(pat[patlen] == '\0');
+
/* special-case "", "%s", and "%-p" (SVf - see below) */
if (patlen == 0) {
if (svmax && ckWARN(WARN_REDUNDANT))
}
#if !defined(USE_LONG_DOUBLE) && !defined(USE_QUADMATH)
- /* special-case "%.0f" and "%.<number>g" */
- if ( !args && 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');
-
- /* XXX: Why do this `svix < svmax` test? Couldn't we just
- format the first argument and WARN_REDUNDANT if svmax > 1?
- Munged by Nicholas Clark in v5.13.0-209-g95ea86d */
- if (pp + 1 == pat + patlen && svix < svmax) {
- const NV nv = SvNV(*svargs);
- if (LIKELY(!Perl_isinfnan(nv))) {
- if (*pp == 'g') {
- /* Add check for digits != 0 because it seems that some
- gconverts are buggy in this case, and we don't yet have
- a Configure test for this. */
- if (digits && digits < sizeof(ebuf) - NV_DIG - 10) {
- /* 0, point, slack */
- STORE_LC_NUMERIC_SET_TO_NEEDED();
- SNPRINTF_G(nv, ebuf, sizeof(ebuf), digits);
- sv_catpv_nomg(sv, ebuf);
- if (*ebuf) /* May return an empty string for digits==0 */
- return;
- }
- } else if (!digits) {
- STRLEN l;
+ /* 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 ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
- sv_catpvn_nomg(sv, p, l);
- return;
- }
- }
+ if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
+ sv_catpvn_nomg(sv, p, l);
+ return;
}
}
}
#endif /* !USE_LONG_DOUBLE */
- if (!args && svix < svmax && DO_UTF8(*svargs))
- has_utf8 = TRUE;
-
patend = (char*)pat + patlen;
for (p = (char*)pat; p < patend; p = q) {
case 'a': case 'A':
{
- bool is_simple; /* no fancy qualifiers */
STRLEN radix_len; /* SvCUR(PL_numeric_radix_sv) */
STRLEN float_need; /* what PL_efloatsize needs to become */
+ bool hexfp; /* hexadecimal floating point? */
vcatpvfn_long_double_t fv;
NV nv;
}
/* special-case "%.0f" */
- is_simple = ( !(width || left || plus || alt)
- && fill != '0'
- && has_precis
- && intsize != 'q');
-
- if (is_simple && c == 'f' && !precis) {
- if ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen)))
- break;
- }
+ if ( c == 'f'
+ && !precis
+ && has_precis
+ && !(width || left || plus || alt)
+ && fill != '0'
+ && intsize != 'q'
+ && ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen)))
+ )
+ goto float_concat_no_utf8;
/* Determine the buffer size needed for the various
* floating-point formats.
* below, or implicitly, via an snprintf() variant.
* Note also things like ps_AF.utf8 which has
* "\N{ARABIC DECIMAL SEPARATOR} as a radix point */
- STORE_LC_NUMERIC_SET_TO_NEEDED();
- if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
+ if (!lc_numeric_set) {
+ /* only set once and reuse in-locale value on subsequent
+ * iterations.
+ * XXX what happens if we die in an eval?
+ */
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+ lc_numeric_set = TRUE;
+ }
+
+ 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);
}
- RESTORE_LC_NUMERIC();
#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 (isALPHA_FOLD_EQ(c, 'f')) {
/* Determine how many digits before the radix point
* might be emitted. frexp() (or frexpl) has some
float_need += digits;
}
}
+ /* special-case "%.<number>g" if it will fit in ebuf */
+ else if (c == 'g'
+ && precis /* See earlier comment about buggy Gconvert
+ when digits, aka precis, is 0 */
+ && has_precis
+ /* check, in manner not involving wrapping, that it will
+ * fit in ebuf */
+ && float_need < sizeof(ebuf)
+ && sizeof(ebuf) - float_need > precis
+ && !(width || left || plus || alt)
+ && fill != '0'
+ && intsize != 'q'
+ ) {
+ SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis);
+ elen = strlen(ebuf);
+ eptr = ebuf;
+ goto float_concat;
+ }
+
{
STRLEN pr = has_precis ? precis : 6; /* known default */
PL_efloatbuf[0] = '\0';
}
- /* special-case "%.<number>g" */
- if (is_simple) {
- /* See earlier comment about buggy Gconvert when digits,
- aka precis is 0 */
- if ( c == 'g' && precis ) {
- STORE_LC_NUMERIC_SET_TO_NEEDED();
- SNPRINTF_G(fv, PL_efloatbuf, PL_efloatsize, precis);
- /* May return an empty string for digits==0 */
- if (*PL_efloatbuf) {
- elen = strlen(PL_efloatbuf);
- goto float_converted;
- }
- }
- }
-
if (UNLIKELY(hexfp)) {
elen = S_format_hexfp(aTHX_ PL_efloatbuf, PL_efloatsize, c,
nv, fv, has_precis, precis, width,
* where printf() taints but print($float) doesn't.
* --jhi */
- STORE_LC_NUMERIC_SET_TO_NEEDED();
-
/* hopefully the above makes ptr a very constrained format
* that is safe to use, even though it's not literal */
GCC_DIAG_IGNORE(-Wformat-nonliteral);
GCC_DIAG_RESTORE;
}
- float_converted:
eptr = PL_efloatbuf;
- assert((IV)elen > 0); /* here zero elen is bad */
+ float_concat:
- break;
+ /* Since floating-point formats do their own formatting and
+ * padding, we skip the main block of code at the end of this
+ * 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(!vectorize);
+ assert(elen);
+ assert(elen >= width);
+
+
+ {
+ /* 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;
}
/* SPECIAL */