return;
}
+
+/* forward declaration */
+static void S_sv_uncow(pTHX_ SV * const sv, const U32 flags);
+
+
/*
=for apidoc sv_grow
=cut
*/
-static void S_sv_uncow(pTHX_ SV * const sv, const U32 flags);
char *
Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen)
/* diag_listed_as: Can't coerce %s to %s in %s */
Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0),
OP_DESC(PL_op));
+ NOT_REACHED; /* NOTREACHED */
break;
default: NOOP;
}
/* diag_listed_as: Can't coerce %s to %s in %s */
Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),
OP_DESC(PL_op));
+ NOT_REACHED; /* NOTREACHED */
break;
default: NOOP;
}
return 0;
}
assert((s == buffer + 3) || (s == buffer + 4));
- *s++ = 0;
- return s - buffer - 1; /* -1: excluding the zero byte */
+ *s = 0;
+ return s - buffer;
}
/*
STORE_LC_NUMERIC_SET_TO_NEEDED();
local_radix = PL_numeric_local && PL_numeric_radix_sv;
- if (local_radix && SvLEN(PL_numeric_radix_sv) > 1) {
- size += SvLEN(PL_numeric_radix_sv) - 1;
+ if (local_radix && SvCUR(PL_numeric_radix_sv) > 1) {
+ size += SvCUR(PL_numeric_radix_sv) - 1;
s = SvGROW_mutable(sv, size);
}
assert(SvPOK(buffer));
if (SvUTF8(buffer))
SvUTF8_on(sv);
+ else
+ SvUTF8_off(sv);
if (lp)
*lp = SvCUR(buffer);
return SvPVX(buffer);
The perl equivalent is C<$sv = undef;>. Note that it doesn't free any string
buffer, unlike C<undef $sv>.
-Introduced in perl 5.26.0.
+Introduced in perl 5.25.12.
=cut
*/
PERL_ARGS_ASSERT_SV_SETPVN;
SV_CHECK_THINKFIRST_COW_DROP(sv);
+ if (isGV_with_GP(sv))
+ Perl_croak_no_modify();
if (!ptr) {
(void)SvOK_off(sv);
return;
SvSETMAGIC(sv);
}
-/*
-=for apidoc sv_force_normal_flags
-
-Undo various types of fakery on an SV, where fakery means
-"more than" a string: if the PV is a shared string, make
-a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
-an C<xpvmg>; if we're a copy-on-write scalar, this is the on-write time when
-we do the copy, and is also used locally; if this is a
-vstring, drop the vstring magic. If C<SV_COW_DROP_PV> is set
-then a copy-on-write scalar drops its PV buffer (if any) and becomes
-C<SvPOK_off> rather than making a copy. (Used where this
-scalar is about to be set to some other value.) In addition,
-the C<flags> parameter gets passed to C<sv_unref_flags()>
-when unreffing. C<sv_force_normal> calls this function
-with flags set to 0.
-
-This function is expected to be used to signal to perl that this SV is
-about to be written to, and any extra book-keeping needs to be taken care
-of. Hence, it croaks on read-only values.
-
-=cut
-*/
static void
S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
}
}
+
+/*
+=for apidoc sv_force_normal_flags
+
+Undo various types of fakery on an SV, where fakery means
+"more than" a string: if the PV is a shared string, make
+a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
+an C<xpvmg>; if we're a copy-on-write scalar, this is the on-write time when
+we do the copy, and is also used locally; if this is a
+vstring, drop the vstring magic. If C<SV_COW_DROP_PV> is set
+then a copy-on-write scalar drops its PV buffer (if any) and becomes
+C<SvPOK_off> rather than making a copy. (Used where this
+scalar is about to be set to some other value.) In addition,
+the C<flags> parameter gets passed to C<sv_unref_flags()>
+when unreffing. C<sv_force_normal> calls this function
+with flags set to 0.
+
+This function is expected to be used to signal to perl that this SV is
+about to be written to, and any extra book-keeping needs to be taken care
+of. Hence, it croaks on read-only values.
+
+=cut
+*/
+
void
Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
{
*/
void
-Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
+Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *little, const STRLEN littlelen, const U32 flags)
{
char *big;
char *mid;
SvPV_force_flags(bigstr, curlen, flags);
(void)SvPOK_only_UTF8(bigstr);
+
+ if (little >= SvPVX(bigstr) &&
+ little < SvPVX(bigstr) + (SvLEN(bigstr) ? SvLEN(bigstr) : SvCUR(bigstr))) {
+ /* little is a pointer to within bigstr, since we can reallocate bigstr,
+ or little...little+littlelen might overlap offset...offset+len we make a copy
+ */
+ little = savepvn(little, littlelen);
+ SAVEFREEPV(little);
+ }
+
if (offset + len > curlen) {
SvGROW(bigstr, offset+len+1);
Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
C<strlen()>, (which means if you use this option, that C<s> can't have embedded
C<NUL> characters and has to have a terminating C<NUL> byte).
-For efficiency, consider using C<newSVpvn> instead.
+This function can cause reliability issues if you are likely to pass in
+empty strings that are not null terminated, because it will run
+strlen on the string and potentially run past valid memory.
+
+Using L</newSVpvn> is a safer alternative for non C<NUL> terminated strings.
+For string literals use L</newSVpvs> instead. This function will work fine for
+C<NUL> terminated strings, but if you want to avoid the if statement on whether
+to call C<strlen> use C<newSVpvn> instead (calling C<strlen> yourself).
=cut
*/
return var;
}
+/* Implement a fast "%.0f": given a pointer to the end of a buffer (caller
+ * ensures it's big enough), back fill it with the rounded integer part of
+ * nv. Returns ptr to start of string, and sets *len to its length.
+ * Returns NULL if not convertible.
+ */
+
STATIC char *
S_F0convert(NV nv, char *const endbuf, STRLEN *const len)
{
PERL_ARGS_ASSERT_F0CONVERT;
- if (UNLIKELY(Perl_isinfnan(nv))) {
- STRLEN n = S_infnan_2pv(nv, endbuf - *len, *len, 0);
- *len = n;
- return endbuf - n;
- }
+ assert(!Perl_isinfnan(nv));
if (neg)
nv = -nv;
if (nv < UV_MAX) {
} STMT_END
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.
+ */
+
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,
const U32 flags)
}
#if !defined(USE_LONG_DOUBLE) && !defined(USE_QUADMATH)
- /* special-case "%.<number>[gf]" */
+ /* 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;
/* 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 - pat == (int)patlen - 1 && svix < svmax) {
+ if (pp + 1 == pat + patlen && svix < svmax) {
const NV nv = SvNV(*svargs);
if (LIKELY(!Perl_isinfnan(nv))) {
if (*pp == 'g') {
if (digits && digits < sizeof(ebuf) - NV_DIG - 10) {
/* 0, point, slack */
STORE_LC_NUMERIC_SET_TO_NEEDED();
- SNPRINTF_G(nv, ebuf, size, digits);
+ SNPRINTF_G(nv, ebuf, sizeof(ebuf), digits);
sv_catpv_nomg(sv, ebuf);
if (*ebuf) /* May return an empty string for digits==0 */
return;
bool is_utf8 = FALSE; /* is this item utf8? */
bool used_explicit_ix = FALSE;
bool arg_missing = FALSE;
-#ifdef HAS_LDBL_SPRINTF_BUG
- /* This is to try to fix a bug with irix/nonstop-ux/powerux and
- with sfio - Allen <allens@cpan.org> */
- bool fix_ldbl_sprintf_bug = FALSE;
-#endif
-
char esignbuf[4];
U8 utf8buf[UTF8_MAXBYTES+1];
STRLEN esignlen = 0;
const U8 *vecstr = NULL;
STRLEN veclen = 0;
char c = 0;
- int i;
unsigned base = 0;
IV iv = 0;
UV uv = 0;
+ bool is_simple = TRUE; /* no fancy qualifiers */
+ STRLEN radix_len; /* SvCUR(PL_numeric_radix_sv) */
+
/* We need a long double target in case HAS_LONG_DOUBLE,
* even without USE_LONG_DOUBLE, so that we can printf with
* long double formats, even without NV being long double.
# define FV_ISFINITE(x) Perl_isfinite((NV)(x))
#endif
NV nv;
- STRLEN have;
- STRLEN need;
- STRLEN gap;
+ STRLEN float_need; /* what PL_efloatsize needs to become */
const char *dotstr = ".";
STRLEN dotstrlen = 1;
I32 efix = 0; /* explicit format parameter index */
}
if (asterisk) {
+ int i;
if (args)
i = va_arg(*args, int);
else
if (*q == '.') {
q++;
if (*q == '*') {
+ int i;
q++;
if ( (epix = expect_number(&q)) ) {
if (*q++ == '$') {
NV_TO_FV(nv, fv);
}
- need = 0;
+ if (Perl_isinfnan(nv)) {
+ elen = S_infnan_2pv(nv, ebuf, sizeof(ebuf), plus);
+ assert(elen);
+ eptr = ebuf;
+ zeros = 0;
+ esignlen = 0;
+ dotstrlen = 0;
+ break;
+ }
+
+ /* 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;
+ }
+
+ /*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.
+ * 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)) {
+ 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
+ float_need = radix_len;
+
/* frexp() (or frexpl) has some unspecified behaviour for
- * nan/inf/-inf, so let's avoid calling that on non-finites. */
- if (isALPHA_FOLD_NE(c, 'e') && FV_ISFINITE(fv)) {
- i = PERL_INT_MIN;
+ * nan/inf/-inf, so lucky we've already handled them above */
+ if (isALPHA_FOLD_NE(c, 'e')) {
+ int i = PERL_INT_MIN;
(void)Perl_frexp((NV)fv, &i);
if (i == PERL_INT_MIN)
Perl_die(aTHX_ "panic: frexp: %" FV_GF, fv);
- /* Do not set hexfp earlier since we want to printf
- * Inf/NaN for Inf/NaN, not their hexfp. */
hexfp = isALPHA_FOLD_EQ(c, 'a');
if (UNLIKELY(hexfp)) {
/* This seriously overshoots in most cases, but
* exponent. Secondly, for the reasonably common
* long doubles case, the "80-bit extended", two
* or six bytes of the NV are unused. */
- need +=
+ float_need +=
(fv < 0) ? 1 : 0 + /* possible unary minus */
2 + /* "0x" */
1 + /* the very unlikely carry */
* See the definition of DOUBLEDOUBLE_MAXBITS.
*
* Need 2 hexdigits for each byte. */
- need += (DOUBLEDOUBLE_MAXBITS/8 + 1) * 2;
+ float_need += (DOUBLEDOUBLE_MAXBITS/8 + 1) * 2;
/* the size for the exponent already added */
#endif
-#ifdef USE_LOCALE_NUMERIC
- STORE_LC_NUMERIC_SET_TO_NEEDED();
- if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC))
- need += SvLEN(PL_numeric_radix_sv);
- RESTORE_LC_NUMERIC();
-#endif
}
else if (i > 0) {
- need = BIT_DIGITS(i);
+ float_need = BIT_DIGITS(i);
} /* if i < 0, the number of digits is hard to predict. */
}
- need += has_precis ? precis : 6; /* known default */
- if (need < width)
- need = width;
+ {
+ STRLEN pr = has_precis ? precis : 6; /* known default */
+ if (float_need >= ((STRLEN)~0) - pr)
+ croak_memory_wrap();
+ float_need += pr;
+ }
+
+ if (float_need < width)
+ float_need = width;
#ifdef HAS_LDBL_SPRINTF_BUG
/* This is to try to fix a bug with irix/nonstop-ux/powerux and
if ((intsize == 'q') && (c == 'f') &&
((fv < MY_DBL_MAX_BUG) && (fv > -MY_DBL_MAX_BUG)) &&
- (need < DBL_DIG)) {
+ (float_need < DBL_DIG))
+ {
+ bool fix_ldbl_sprintf_bug = FALSE;
+
/* it's going to be short enough that
* long double precision is not needed */
fix_ldbl_sprintf_bug = TRUE;
}
}
+
if (fix_ldbl_sprintf_bug == TRUE) {
double temp;
#endif /* HAS_LDBL_SPRINTF_BUG */
- need += 20; /* fudge factor */
- if (PL_efloatsize < need) {
+ if (float_need >= ((STRLEN)~0) - 40)
+ croak_memory_wrap();
+ float_need += 40; /* fudge factor */
+ if (PL_efloatsize < float_need) {
Safefree(PL_efloatbuf);
- PL_efloatsize = need + 20; /* more fudge */
+ PL_efloatsize = float_need;
Newx(PL_efloatbuf, PL_efloatsize, char);
PL_efloatbuf[0] = '\0';
}
- if ( !(width || left || plus || alt) && fill != '0'
- && has_precis && intsize != 'q' /* Shortcuts */
- && LIKELY(!Perl_isinfnan((NV)fv)) ) {
+ /* special-case "%.<number>g" */
+ if (is_simple) {
/* See earlier comment about buggy Gconvert when digits,
aka precis is 0 */
if ( c == 'g' && precis ) {
elen = strlen(PL_efloatbuf);
goto float_converted;
}
- } else if ( c == 'f' && !precis ) {
- if ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen)))
- break;
- }
+ }
}
if (UNLIKELY(hexfp)) {
if (has_precis) {
U8* ve = (subnormal ? vlnz + 1 : vend);
- SSize_t vn = ve - (subnormal ? vfnz : vhex);
- if ((SSize_t)(precis + 1) < vn) {
+ SSize_t vn = ve - v0;
+ assert(vn >= 1);
+ if (precis < (Size_t)(vn - 1)) {
bool overflow = FALSE;
if (v0[precis + 1] < 0x8) {
/* Round down, nothing to do. */
* way to the front, we need to
* insert 0x1 in front, and adjust
* the exponent. */
- Move(v0, v0 + 1, vn, char);
+ Move(v0, v0 + 1, vn - 1, char);
*v0 = 0x1;
exponent += 4;
}
exponent);
if (elen < width) {
+ STRLEN gap = (STRLEN)(width - elen);
if (left) {
/* Pad the back with spaces. */
- memset(PL_efloatbuf + elen, ' ', width - elen);
+ memset(PL_efloatbuf + elen, ' ', gap);
}
else if (fill == '0') {
/* Insert the zeros after the "0x" and the
* the potential sign, but before the digits,
* otherwise we end up with "0000xH.HHH...",
* when we want "0x000H.HHH..." */
- STRLEN nzero = width - elen;
+ STRLEN nzero = gap;
char* zerox = PL_efloatbuf + 2;
STRLEN nmove = elen - 2;
if (negative || plus) {
}
else {
/* Move it to the right. */
- Move(PL_efloatbuf, PL_efloatbuf + width - elen,
+ Move(PL_efloatbuf, PL_efloatbuf + gap,
elen, char);
/* Pad the front with spaces. */
- memset(PL_efloatbuf, ' ', width - elen);
+ memset(PL_efloatbuf, ' ', gap);
}
elen = width;
}
}
else {
- elen = S_infnan_2pv(nv, PL_efloatbuf, PL_efloatsize, plus);
- if (elen) {
- /* Not affecting infnan output: precision, alt, fill. */
- if (elen < width) {
- if (left) {
- /* Pack the back with spaces. */
- memset(PL_efloatbuf + elen, ' ', width - elen);
- } else {
- /* Move it to the right. */
- Move(PL_efloatbuf, PL_efloatbuf + width - elen,
- elen, char);
- /* Pad the front with spaces. */
- memset(PL_efloatbuf, ' ', width - elen);
- }
- elen = width;
- }
- }
- }
-
- if (elen == 0) {
char *ptr = ebuf + sizeof ebuf;
*--ptr = '\0';
*--ptr = c;
Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr);
elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
qfmt, nv);
- if ((IV)elen == -1)
+ if ((IV)elen == -1) {
+ if (qfmt != ptr)
+ SAVEFREEPV(qfmt);
Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
+ }
if (qfmt != ptr)
Safefree(qfmt);
}
eptr = PL_efloatbuf;
assert((IV)elen > 0); /* here zero elen is bad */
-#ifdef USE_LOCALE_NUMERIC
- /* If the decimal point character in the string is UTF-8, make the
- * output utf8 */
- if (PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv)
- && instr(eptr, SvPVX_const(PL_numeric_radix_sv)))
- {
- is_utf8 = TRUE;
- }
-#endif
break;
/* SPECIAL */
case 'n':
- if (vectorize)
- goto unknown;
- i = SvCUR(sv) - origlen;
- if (args) {
- switch (intsize) {
- case 'c': *(va_arg(*args, char*)) = i; break;
- case 'h': *(va_arg(*args, short*)) = i; break;
- default: *(va_arg(*args, int*)) = i; break;
- case 'l': *(va_arg(*args, long*)) = i; break;
- case 'V': *(va_arg(*args, IV*)) = i; break;
- case 'z': *(va_arg(*args, SSize_t*)) = i; break;
+ {
+ int i;
+ if (vectorize)
+ goto unknown;
+ i = SvCUR(sv) - origlen;
+ if (args) {
+ switch (intsize) {
+ case 'c': *(va_arg(*args, char*)) = i; break;
+ case 'h': *(va_arg(*args, short*)) = i; break;
+ default: *(va_arg(*args, int*)) = i; break;
+ case 'l': *(va_arg(*args, long*)) = i; break;
+ case 'V': *(va_arg(*args, IV*)) = i; break;
+ case 'z': *(va_arg(*args, SSize_t*)) = i; break;
#ifdef HAS_PTRDIFF_T
- case 't': *(va_arg(*args, ptrdiff_t*)) = i; break;
+ case 't': *(va_arg(*args, ptrdiff_t*)) = i; break;
#endif
#ifdef I_STDINT
- case 'j': *(va_arg(*args, intmax_t*)) = i; break;
+ case 'j': *(va_arg(*args, intmax_t*)) = i; break;
#endif
- case 'q':
+ case 'q':
#if IVSIZE >= 8
- *(va_arg(*args, Quad_t*)) = i; break;
+ *(va_arg(*args, Quad_t*)) = i; break;
#else
- goto unknown;
+ goto unknown;
#endif
- }
- }
- else
- sv_setuv_mg(argsv, has_utf8 ? (UV)sv_len_utf8(sv) : (UV)i);
- goto donevalidconversion;
+ }
+ }
+ else
+ sv_setuv_mg(argsv, has_utf8 ? (UV)sv_len_utf8(sv) : (UV)i);
+ goto donevalidconversion;
+ }
/* UNKNOWN */
Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%" SVf, SVfARG(msg)); /* yes, this is reentrant */
}
- /* output mangled stuff ... */
- if (c == '\0')
- --q;
- eptr = p;
- elen = q - p;
-
- /* ... right here, because formatting flags should not apply */
- SvGROW(sv, SvCUR(sv) + elen + 1);
- p = SvEND(sv);
- Copy(eptr, p, elen, char);
- p += elen;
- *p = '\0';
- SvCUR_set(sv, p - SvPVX_const(sv));
+ /* mangled format: output the '%', then continue from the
+ * character following that */
+ sv_catpvn_nomg(sv, p, 1);
+ q = p + 1;
svix = osvix;
continue; /* not "break" */
}
}
}
- /* signed value that's wrapped? */
- assert(elen <= ((~(STRLEN)0) >> 1));
- have = esignlen + zeros + elen;
- if (have < zeros)
- croak_memory_wrap();
-
- need = (have > width ? have : width);
- gap = need - have;
-
- if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
- croak_memory_wrap();
- SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
- p = SvEND(sv);
- if (esignlen && fill == '0') {
- int i;
- for (i = 0; i < (int)esignlen; i++)
- *p++ = esignbuf[i];
- }
- if (gap && !left) {
- memset(p, fill, gap);
- p += gap;
- }
- if (esignlen && fill != '0') {
- int i;
- for (i = 0; i < (int)esignlen; i++)
- *p++ = esignbuf[i];
- }
- if (zeros) {
- int i;
- for (i = zeros; i; i--)
- *p++ = '0';
- }
- if (elen) {
- Copy(eptr, p, elen, char);
- p += elen;
- }
- if (gap && left) {
- memset(p, ' ', gap);
- p += gap;
- }
- if (vectorize) {
- if (veclen) {
- Copy(dotstr, p, dotstrlen, char);
- p += dotstrlen;
- }
- else
- vectorize = FALSE; /* done iterating over vecstr */
- }
- if (is_utf8)
- has_utf8 = TRUE;
- if (has_utf8)
- SvUTF8_on(sv);
- *p = '\0';
- SvCUR_set(sv, p - SvPVX_const(sv));
+
+ /* append esignbuf, filler, zeros, eptr and dotstr to sv */
+
+ {
+ STRLEN need, have, gap;
+
+ /* 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 (have >= (((STRLEN)~0) - esignlen))
+ croak_memory_wrap();
+ have += esignlen;
+
+ need = (have > width ? have : width);
+ gap = need - have;
+
+ if (need >= (((STRLEN)~0) - dotstrlen))
+ croak_memory_wrap();
+ need += dotstrlen;
+
+ if (need >= (((STRLEN)~0) - (SvCUR(sv) + 1)))
+ croak_memory_wrap();
+ need += (SvCUR(sv) + 1);
+
+ SvGROW(sv, need);
+
+ p = SvEND(sv);
+ if (esignlen && fill == '0') {
+ int i;
+ for (i = 0; i < (int)esignlen; i++)
+ *p++ = esignbuf[i];
+ }
+ if (gap && !left) {
+ memset(p, fill, gap);
+ p += gap;
+ }
+ if (esignlen && fill != '0') {
+ int i;
+ for (i = 0; i < (int)esignlen; i++)
+ *p++ = esignbuf[i];
+ }
+ if (zeros) {
+ int i;
+ for (i = zeros; i; i--)
+ *p++ = '0';
+ }
+ if (elen) {
+ Copy(eptr, p, elen, char);
+ p += elen;
+ }
+ if (gap && left) {
+ memset(p, ' ', gap);
+ p += gap;
+ }
+ if (vectorize) {
+ if (veclen) {
+ Copy(dotstr, p, dotstrlen, char);
+ p += dotstrlen;
+ }
+ else
+ vectorize = FALSE; /* done iterating over vecstr */
+ }
+ if (is_utf8)
+ has_utf8 = TRUE;
+ if (has_utf8)
+ SvUTF8_on(sv);
+ *p = '\0';
+ SvCUR_set(sv, p - SvPVX_const(sv));
+ }
+
if (vectorize) {
esignlen = 0;
goto vector;
parser->sig_elems = proto->sig_elems;
parser->sig_optelems= proto->sig_optelems;
parser->sig_slurpy = proto->sig_slurpy;
+ parser->recheck_utf8_validity = proto->recheck_utf8_validity;
parser->linestr = sv_dup_inc(proto->linestr, param);
{
switch (sv_type) {
default:
Perl_croak(aTHX_ "Bizarre SvTYPE [%" IVdf "]", (IV)SvTYPE(sstr));
+ NOT_REACHED; /* NOTREACHED */
break;
case SVt_PVGV:
PL_Xpv = (XPV*)NULL;
my_perl->Ina = proto_perl->Ina;
- PL_statbuf = proto_perl->Istatbuf;
PL_statcache = proto_perl->Istatcache;
#ifndef NO_TAINT_SUPPORT
https://perl5.git.perl.org / perl5.git / blobdiff