uv = iv;
sign = 0;
} else {
- uv = -(UV)iv;
+ /* Using 0- here to silence bogus warning from MS VC */
+ uv = (UV) (0 - (UV) iv);
sign = 1;
}
Note we have to deal with the char in 'i' if we are not at EOF
*/
+ bpx = bp - (STDCHAR*)SvPVX_const(sv);
+ /* signals might be called here, possibly modifying sv */
i = PerlIO_getc(fp); /* get more characters */
+ bp = (STDCHAR*)SvPVX_const(sv) + bpx;
DEBUG_Pv(PerlIO_printf(Perl_debug_log,
"Screamer: post: FILE * thinks ptr=%" UVuf ", cnt=%" IVdf ", base=%" UVuf "\n",
explicit call to C<FREETMPS>, or by an implicit call at places such as
statement boundaries. See also C<L</sv_newmortal>> and C<L</sv_2mortal>>.
+=for apidoc sv_mortalcopy_flags
+
+Like C<sv_mortalcopy>, but the extra C<flags> are passed to the
+C<sv_setsv_flags>.
+
=cut
*/
Creates a new SV for the existing RV, C<rv>, to point to. If C<rv> is not an
RV then it will be upgraded to one. If C<classname> is non-null then the new
SV will be blessed in the specified package. The new SV is returned and its
-reference count is 1. The reference count 1 is owned by C<rv>.
+reference count is 1. The reference count 1 is owned by C<rv>. See also
+newRV_inc() and newRV_noinc() for creating a new RV properly.
=cut
*/
/*
=for apidoc sv_catpvf
-Processes its arguments like C<sv_catpvfn>, and appends the formatted
-output to an SV. As with C<sv_catpvfn> called with a non-null C-style
+Processes its arguments like C<sprintf>, and appends the formatted
+output to an SV. As with C<sv_vcatpvfn> called with a non-null C-style
variable argument list, argument reordering is not supported.
If the appended data contains "wide" characters
(including, but not limited to, SVs with a UTF-8 PV formatted with C<%s>,
/*
=for apidoc sv_vcatpvf
-Processes its arguments like C<sv_catpvfn> called with a non-null C-style
+Processes its arguments like C<sv_vcatpvfn> called with a non-null C-style
variable argument list, and appends the formatted output
to an SV. Does not handle 'set' magic. See C<L</sv_vcatpvf_mg>>.
return (STRLEN)iv;
}
-
-/* Returns true if c is in the range '1'..'9'
- * Written with the cast so it only needs one conditional test
- */
-#define IS_1_TO_9(c) ((U8)(c - '1') <= 8)
-
/* Read in and return a number. Updates *pattern to point to the char
* following the number. Expects the first char to 1..9.
* Croaks if the number exceeds 1/4 of the maximum value of STRLEN.
PERL_ARGS_ASSERT_EXPECT_NUMBER;
- assert(IS_1_TO_9(**pattern));
+ assert(inRANGE(**pattern, '1', '9'));
var = *(*pattern)++ - '0';
while (isDIGIT(**pattern)) {
else {
*p++ = '0';
exponent = 0;
- zerotail = precis;
+ zerotail = has_precis ? precis : 0;
}
/* The radix is always output if precis, or if alt. */
- if (precis > 0 || alt) {
+ if ((has_precis && precis > 0) || alt) {
hexradix = TRUE;
}
[%bcdefginopsuxDFOUX] format (mandatory)
*/
- if (IS_1_TO_9(*q)) {
+ if (inRANGE(*q, '1', '9')) {
width = expect_number(&q);
if (*q == '$') {
if (args)
Perl_croak_nocontext(
- "Cannot yet reorder sv_catpvfn() arguments from va_list");
+ "Cannot yet reorder sv_vcatpvfn() arguments from va_list");
++q;
efix = (Size_t)width;
width = 0;
if (*q == '*') {
STRLEN ix; /* explicit width/vector separator index */
q++;
- if (IS_1_TO_9(*q)) {
+ if (inRANGE(*q, '1', '9')) {
ix = expect_number(&q);
if (*q++ == '$') {
if (args)
Perl_croak_nocontext(
- "Cannot yet reorder sv_catpvfn() arguments from va_list");
+ "Cannot yet reorder sv_vcatpvfn() arguments from va_list");
no_redundant_warning = TRUE;
} else
goto unknown;
fill = TRUE;
q++;
}
- if (IS_1_TO_9(*q))
+ if (inRANGE(*q, '1', '9'))
width = expect_number(&q);
}
if (*q == '*') {
STRLEN ix; /* explicit precision index */
q++;
- if (IS_1_TO_9(*q)) {
+ if (inRANGE(*q, '1', '9')) {
ix = expect_number(&q);
if (*q++ == '$') {
if (args)
Perl_croak_nocontext(
- "Cannot yet reorder sv_catpvfn() arguments from va_list");
+ "Cannot yet reorder sv_vcatpvfn() arguments from va_list");
no_redundant_warning = TRUE;
} else
goto unknown;
}
precis = S_sprintf_arg_num_val(aTHX_ args, i, sv, &neg);
has_precis = !neg;
+ /* ignore negative precision */
+ if (!has_precis)
+ precis = 0;
}
}
else {
*/
while (*q == '0')
q++;
- precis = IS_1_TO_9(*q) ? expect_number(&q) : 0;
+ precis = inRANGE(*q, '1', '9') ? expect_number(&q) : 0;
has_precis = TRUE;
}
}
case 't': iv = va_arg(*args, ptrdiff_t); break;
#endif
default: iv = va_arg(*args, int); break;
- case 'j': iv = va_arg(*args, PERL_INTMAX_T); break;
+ case 'j': iv = (IV) va_arg(*args, PERL_INTMAX_T); break;
case 'q':
#if IVSIZE >= 8
iv = va_arg(*args, Quad_t); break;
esignbuf[esignlen++] = plus;
}
else {
- uv = -(UV)iv;
+ /* Using 0- here to silence bogus warning from MS VC */
+ uv = (UV) (0 - (UV) iv);
esignbuf[esignlen++] = '-';
}
}
* uptrdiff_t, so oh well */
case 't': uv = va_arg(*args, ptrdiff_t); break;
#endif
- case 'j': uv = va_arg(*args, PERL_UINTMAX_T); break;
+ case 'j': uv = (UV) va_arg(*args, PERL_UINTMAX_T); break;
default: uv = va_arg(*args, unsigned); break;
case 'q':
#if IVSIZE >= 8
if (float_need < width)
float_need = width;
+ if (float_need > INT_MAX) {
+ /* snprintf() returns an int, and we use that return value,
+ so die horribly if the expected size is too large for int
+ */
+ Perl_croak(aTHX_ "Numeric format result too large");
+ }
+
if (PL_efloatsize <= float_need) {
/* PL_efloatbuf should be at least 1 greater than
* float_need to allow a trailing \0 to be returned by
https://perl5.git.perl.org / perl5.git / blobdiff