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;
}
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
*/
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)
{
# 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 */
NV_TO_FV(nv, fv);
}
- need = 0;
+ float_need = 0;
/* 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)) {
* 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);
+ float_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)) {
/* it's going to be short enough that
* long double precision is not needed */
#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';
}
}
}
- /* 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;
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