#define FCALL *f
+#ifdef PERL_UTF8_CACHE_ASSERT
+/* The cache element 0 is the Unicode offset;
+ * the cache element 1 is the byte offset of the element 0;
+ * the cache element 2 is the Unicode length of the substring;
+ * the cache element 3 is the byte length of the substring;
+ * The checking of the substring side would be good
+ * but substr() has enough code paths to make my head spin;
+ * if adding more checks watch out for the following tests:
+ * t/op/index.t t/op/length.t t/op/pat.t t/op/substr.t
+ * lib/utf8.t lib/Unicode/Collate/t/index.t
+ * --jhi
+ */
+#define ASSERT_UTF8_CACHE(cache) \
+ STMT_START { if (cache) { assert((cache)[0] <= (cache)[1]); } } STMT_END
+#else
+#define ASSERT_UTF8_CACHE(cache) NOOP
+#endif
+
#ifdef PERL_COPY_ON_WRITE
#define SV_COW_NEXT_SV(sv) INT2PTR(SV *,SvUVX(sv))
#define SV_COW_NEXT_SV_SET(current,next) SvUVX(current) = PTR2UV(next)
Safefree(arena);
}
PL_xiv_arenaroot = 0;
+ PL_xiv_root = 0;
for (arena = PL_xnv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xnv_arenaroot = 0;
+ PL_xnv_root = 0;
for (arena = PL_xrv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xrv_arenaroot = 0;
+ PL_xrv_root = 0;
for (arena = PL_xpv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpv_arenaroot = 0;
+ PL_xpv_root = 0;
for (arena = (XPV*)PL_xpviv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpviv_arenaroot = 0;
+ PL_xpviv_root = 0;
for (arena = (XPV*)PL_xpvnv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvnv_arenaroot = 0;
+ PL_xpvnv_root = 0;
for (arena = (XPV*)PL_xpvcv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvcv_arenaroot = 0;
+ PL_xpvcv_root = 0;
for (arena = (XPV*)PL_xpvav_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvav_arenaroot = 0;
+ PL_xpvav_root = 0;
for (arena = (XPV*)PL_xpvhv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvhv_arenaroot = 0;
+ PL_xpvhv_root = 0;
for (arena = (XPV*)PL_xpvmg_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvmg_arenaroot = 0;
+ PL_xpvmg_root = 0;
for (arena = (XPV*)PL_xpvlv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvlv_arenaroot = 0;
+ PL_xpvlv_root = 0;
for (arena = (XPV*)PL_xpvbm_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvbm_arenaroot = 0;
+ PL_xpvbm_root = 0;
for (arena = (XPV*)PL_he_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_he_arenaroot = 0;
+ PL_he_root = 0;
if (PL_nice_chunk)
Safefree(PL_nice_chunk);
s = "REF";
else
s = "SCALAR"; break;
- case SVt_PVLV: s = SvROK(sv) ? "REF":"LVALUE"; break;
+ case SVt_PVLV: s = SvROK(sv) ? "REF"
+ /* tied lvalues should appear to be
+ * scalars for backwards compatitbility */
+ : (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
+ ? "SCALAR" : "LVALUE"; break;
case SVt_PVAV: s = "ARRAY"; break;
case SVt_PVHV: s = "HASH"; break;
case SVt_PVCV: s = "CODE"; break;
=for apidoc sv_2pvbyte_nolen
Return a pointer to the byte-encoded representation of the SV.
-May cause the SV to be downgraded from UTF8 as a side-effect.
+May cause the SV to be downgraded from UTF-8 as a side-effect.
Usually accessed via the C<SvPVbyte_nolen> macro.
=for apidoc sv_2pvbyte
Return a pointer to the byte-encoded representation of the SV, and set *lp
-to its length. May cause the SV to be downgraded from UTF8 as a
+to its length. May cause the SV to be downgraded from UTF-8 as a
side-effect.
Usually accessed via the C<SvPVbyte> macro.
/*
=for apidoc sv_2pvutf8_nolen
-Return a pointer to the UTF8-encoded representation of the SV.
-May cause the SV to be upgraded to UTF8 as a side-effect.
+Return a pointer to the UTF-8-encoded representation of the SV.
+May cause the SV to be upgraded to UTF-8 as a side-effect.
Usually accessed via the C<SvPVutf8_nolen> macro.
/*
=for apidoc sv_2pvutf8
-Return a pointer to the UTF8-encoded representation of the SV, and set *lp
-to its length. May cause the SV to be upgraded to UTF8 as a side-effect.
+Return a pointer to the UTF-8-encoded representation of the SV, and set *lp
+to its length. May cause the SV to be upgraded to UTF-8 as a side-effect.
Usually accessed via the C<SvPVutf8> macro.
/*
=for apidoc sv_utf8_upgrade
-Convert the PV of an SV to its UTF8-encoded form.
+Convert the PV of an SV to its UTF-8-encoded form.
Forces the SV to string form if it is not already.
Always sets the SvUTF8 flag to avoid future validity checks even
if all the bytes have hibit clear.
=for apidoc sv_utf8_upgrade_flags
-Convert the PV of an SV to its UTF8-encoded form.
+Convert the PV of an SV to its UTF-8-encoded form.
Forces the SV to string form if it is not already.
Always sets the SvUTF8 flag to avoid future validity checks even
if all the bytes have hibit clear. If C<flags> has C<SV_GMAGIC> bit set,
/*
=for apidoc sv_utf8_downgrade
-Attempt to convert the PV of an SV from UTF8-encoded to byte encoding.
+Attempt to convert the PV of an SV from UTF-8-encoded to byte encoding.
This may not be possible if the PV contains non-byte encoding characters;
if this is the case, either returns false or, if C<fail_ok> is not
true, croaks.
/*
=for apidoc sv_utf8_encode
-Convert the PV of an SV to UTF8-encoded, but then turn off the C<SvUTF8>
+Convert the PV of an SV to UTF-8-encoded, but then turn off the C<SvUTF8>
flag so that it looks like octets again. Used as a building block
for encode_utf8 in Encode.xs
if (dtype < SVt_RV)
sv_upgrade(dstr, SVt_RV);
else if (dtype == SVt_PVGV &&
- SvTYPE(SvRV(sstr)) == SVt_PVGV) {
+ SvROK(sstr) && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
if (GvIMPORTED(dstr) != GVf_IMPORTED
* has to be allocated and SvPVX(sstr) has to be freed.
*/
+ /* Whichever path we take through the next code, we want this true,
+ and doing it now facilitates the COW check. */
+ (void)SvPOK_only(dstr);
+
if (
#ifdef PERL_COPY_ON_WRITE
(sflags & (SVf_FAKE | SVf_READONLY)) != (SVf_FAKE | SVf_READONLY)
!(PL_op && PL_op->op_type == OP_AASSIGN))
#ifdef PERL_COPY_ON_WRITE
&& !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
+ && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
&& SvTYPE(sstr) >= SVt_PVIV)
#endif
) {
Move(SvPVX(sstr),SvPVX(dstr),len,char);
SvCUR_set(dstr, len);
*SvEND(dstr) = '\0';
- (void)SvPOK_only(dstr);
} else {
/* If PERL_COPY_ON_WRITE is not defined, then isSwipe will always
be true in here. */
else if (SvLEN(dstr))
Safefree(SvPVX(dstr));
}
- (void)SvPOK_only(dstr);
#ifdef PERL_COPY_ON_WRITE
if (!isSwipe) {
sv_dump(sv);
}
}
- else if (PL_curcop != &PL_compiling)
+ else if (IN_PERL_RUNTIME)
Perl_croak(aTHX_ PL_no_modify);
/* At this point I believe that I can drop the global SV mutex. */
}
*SvEND(sv) = '\0';
unsharepvn(pvx, SvUTF8(sv) ? -(I32)len : len, hash);
}
- else if (PL_curcop != &PL_compiling)
+ else if (IN_PERL_RUNTIME)
Perl_croak(aTHX_ PL_no_modify);
}
#endif
=for apidoc sv_catpvn
Concatenates the string onto the end of the string which is in the SV. The
-C<len> indicates number of bytes to copy. If the SV has the UTF8
-status set, then the bytes appended should be valid UTF8.
+C<len> indicates number of bytes to copy. If the SV has the UTF-8
+status set, then the bytes appended should be valid UTF-8.
Handles 'get' magic, but not 'set' magic. See C<sv_catpvn_mg>.
=for apidoc sv_catpvn_flags
Concatenates the string onto the end of the string which is in the SV. The
-C<len> indicates number of bytes to copy. If the SV has the UTF8
-status set, then the bytes appended should be valid UTF8.
+C<len> indicates number of bytes to copy. If the SV has the UTF-8
+status set, then the bytes appended should be valid UTF-8.
If C<flags> has C<SV_GMAGIC> bit set, will C<mg_get> on C<dsv> if
appropriate, else not. C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
in terms of this function.
=for apidoc sv_catpv
Concatenates the string onto the end of the string which is in the SV.
-If the SV has the UTF8 status set, then the bytes appended should be
-valid UTF8. Handles 'get' magic, but not 'set' magic. See C<sv_catpv_mg>.
+If the SV has the UTF-8 status set, then the bytes appended should be
+valid UTF-8. Handles 'get' magic, but not 'set' magic. See C<sv_catpv_mg>.
=cut */
sv_force_normal_flags(sv, 0);
#endif
if (SvREADONLY(sv)) {
- if (PL_curcop != &PL_compiling
+ if (IN_PERL_RUNTIME
&& how != PERL_MAGIC_regex_global
&& how != PERL_MAGIC_bm
&& how != PERL_MAGIC_fm
else {
av = newAV();
sv_magic(tsv, (SV*)av, PERL_MAGIC_backref, NULL, 0);
- SvREFCNT_dec(av); /* for sv_magic */
+ /* av now has a refcnt of 2, which avoids it getting freed
+ * before us during global cleanup. The extra ref is removed
+ * by magic_killbackrefs() when tsv is being freed */
}
if (AvFILLp(av) >= AvMAX(av)) {
SV **svp = AvARRAY(av);
#endif
SvREFCNT(sv) = refcnt;
SvFLAGS(nsv) |= SVTYPEMASK; /* Mark as freed */
+ SvREFCNT(nsv) = 0;
del_SV(nsv);
}
return;
}
if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free unreferenced scalar");
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+ "Attempt to free unreferenced scalar: SV 0x%"UVxf,
+ PTR2UV(sv));
return;
}
if (--(SvREFCNT(sv)) > 0)
=for apidoc sv_len_utf8
Returns the number of characters in the string in an SV, counting wide
-UTF8 bytes as a single character. Handles magic and type coercion.
+UTF-8 bytes as a single character. Handles magic and type coercion.
=cut
*/
U8 *s = (U8*)SvPV(sv, len);
MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
- if (mg && mg->mg_len != -1 && (mg->mg_len > 0 || len == 0))
+ if (mg && mg->mg_len != -1 && (mg->mg_len > 0 || len == 0)) {
ulen = mg->mg_len;
+#ifdef PERL_UTF8_CACHE_ASSERT
+ assert(ulen == Perl_utf8_length(aTHX_ s, s + len));
+#endif
+ }
else {
ulen = Perl_utf8_length(aTHX_ s, s + len);
if (!mg && !SvREADONLY(sv)) {
*mgp = mg_find(sv, PERL_MAGIC_utf8);
if (*mgp && (*mgp)->mg_ptr) {
*cachep = (STRLEN *) (*mgp)->mg_ptr;
+ ASSERT_UTF8_CACHE(*cachep);
if ((*cachep)[i] == (STRLEN)uoff) /* An exact match. */
- found = TRUE;
+ found = TRUE;
else { /* We will skip to the right spot. */
STRLEN forw = 0;
STRLEN backw = 0;
}
}
}
+#ifdef PERL_UTF8_CACHE_ASSERT
+ if (found) {
+ U8 *s = start;
+ I32 n = uoff;
+
+ while (n-- && s < send)
+ s += UTF8SKIP(s);
+
+ if (i == 0) {
+ assert(*offsetp == s - start);
+ assert((*cachep)[0] == (STRLEN)uoff);
+ assert((*cachep)[1] == *offsetp);
+ }
+ ASSERT_UTF8_CACHE(*cachep);
+ }
+#endif
}
+
return found;
}
/*
=for apidoc sv_pos_u2b
-Converts the value pointed to by offsetp from a count of UTF8 chars from
+Converts the value pointed to by offsetp from a count of UTF-8 chars from
the start of the string, to a count of the equivalent number of bytes; if
lenp is non-zero, it does the same to lenp, but this time starting from
the offset, rather than from the start of the string. Handles magic and
}
*lenp = s - start;
}
+ ASSERT_UTF8_CACHE(cache);
}
else {
*offsetp = 0;
if (lenp)
*lenp = 0;
}
+
return;
}
=for apidoc sv_pos_b2u
Converts the value pointed to by offsetp from a count of bytes from the
-start of the string, to a count of the equivalent number of UTF8 chars.
+start of the string, to a count of the equivalent number of UTF-8 chars.
Handles magic and type coercion.
=cut
}
}
}
+ ASSERT_UTF8_CACHE(cache);
}
while (s < send) {
if (PerlIO_isutf8(fp))
SvUTF8_on(sv);
- if (PL_curcop == &PL_compiling) {
+ if (IN_PERL_COMPILETIME) {
/* we always read code in line mode */
rsptr = "\n";
rslen = 1;
}
else
{
-#ifndef EPOC
- /*The big, slow, and stupid way */
- STDCHAR buf[8192];
+ /*The big, slow, and stupid way. */
+
+ /* Any stack-challenged places. */
+#if defined(EPOC)
+ /* EPOC: need to work around SDK features. *
+ * On WINS: MS VC5 generates calls to _chkstk, *
+ * if a "large" stack frame is allocated. *
+ * gcc on MARM does not generate calls like these. */
+# define USEHEAPINSTEADOFSTACK
+#endif
+
+#ifdef USEHEAPINSTEADOFSTACK
+ STDCHAR *buf = 0;
+ New(0, buf, 8192, STDCHAR);
+ assert(buf);
#else
- /* Need to work around EPOC SDK features */
- /* On WINS: MS VC5 generates calls to _chkstk, */
- /* if a `large' stack frame is allocated */
- /* gcc on MARM does not generate calls like these */
- STDCHAR buf[1024];
+ STDCHAR buf[8192];
#endif
screamer2:
if (!(cnt < sizeof(buf) && PerlIO_eof(fp)))
goto screamer2;
}
+
+#ifdef USEHEAPINSTEADOFSTACK
+ Safefree(buf);
+#endif
}
if (rspara) { /* have to do this both before and after */
if (SvIsCOW(sv))
sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
- if (PL_curcop != &PL_compiling)
+ if (IN_PERL_RUNTIME)
Perl_croak(aTHX_ PL_no_modify);
}
if (SvROK(sv)) {
if (SvIsCOW(sv))
sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
- if (PL_curcop != &PL_compiling)
+ if (IN_PERL_RUNTIME)
Perl_croak(aTHX_ PL_no_modify);
}
if (SvROK(sv)) {
}
if (GvHV(gv) && !HvNAME(GvHV(gv))) {
hv_clear(GvHV(gv));
+#ifndef PERL_MICRO
#ifdef USE_ENVIRON_ARRAY
if (gv == PL_envgv
# ifdef USE_ITHREADS
environ[0] = Nullch;
}
#endif
+#endif /* !PERL_MICRO */
}
}
}
return "REF";
else
return "SCALAR";
- case SVt_PVLV: return SvROK(sv) ? "REF" : "LVALUE";
+
+ case SVt_PVLV: return SvROK(sv) ? "REF"
+ /* tied lvalues should appear to be
+ * scalars for backwards compatitbility */
+ : (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
+ ? "SCALAR" : "LVALUE";
case SVt_PVAV: return "ARRAY";
case SVt_PVHV: return "HASH";
case SVt_PVCV: return "CODE";
the new SV. If the C<pv> argument is NULL then C<PL_sv_undef> will be placed
into the SV. The C<classname> argument indicates the package for the
blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
-will be returned and will have a reference count of 1.
+will have a reference count of 1, and the RV will be returned.
Do not use with other Perl types such as HV, AV, SV, CV, because those
objects will become corrupted by the pointer copy process.
argument will be upgraded to an RV. That RV will be modified to point to
the new SV. The C<classname> argument indicates the package for the
blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
-will be returned and will have a reference count of 1.
+will have a reference count of 1, and the RV will be returned.
=cut
*/
argument will be upgraded to an RV. That RV will be modified to point to
the new SV. The C<classname> argument indicates the package for the
blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
-will be returned and will have a reference count of 1.
+will have a reference count of 1, and the RV will be returned.
=cut
*/
argument will be upgraded to an RV. That RV will be modified to point to
the new SV. The C<classname> argument indicates the package for the
blessing. Set C<classname> to C<Nullch> to avoid the blessing. The new SV
-will be returned and will have a reference count of 1.
+will have a reference count of 1, and the RV will be returned.
=cut
*/
string must be specified with C<n>. The C<rv> argument will be upgraded to
an RV. That RV will be modified to point to the new SV. The C<classname>
argument indicates the package for the blessing. Set C<classname> to
-C<Nullch> to avoid the blessing. The new SV will be returned and will have
-a reference count of 1.
+C<Nullch> to avoid the blessing. The new SV will have a reference count
+of 1, and the RV will be returned.
Note that C<sv_setref_pv> copies the pointer while this copies the string.
sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
}
-/* strnchr(): private function for use in sv_vcatpvfn()
- *
- * Like strchr(), but allows to use strings that are not null-terminated.
- * The string length must be given instead and it _must_ be correct, as
- * the function does not stop searching when a '\0' is discovered.
- * This would also allow to explicitly search for '\0' characters.
- */
-
-static const char *
-strnchr(const char* s, int c, size_t n)
-{
- if (s)
- for (; n > 0; n--, s++)
- if ((int)*s == c)
- return s;
- return NULL;
-}
-
/* private function for use in sv_vcatpvfn via the EXPECT_NUMBER macro */
STATIC I32
}
#define EXPECT_NUMBER(pattern, var) (var = S_expect_number(aTHX_ &pattern))
+static char *
+F0convert(NV nv, char *endbuf, STRLEN *len)
+{
+ int neg = nv < 0;
+ UV uv;
+ char *p = endbuf;
+
+ if (neg)
+ nv = -nv;
+ if (nv < UV_MAX) {
+ nv += 0.5;
+ uv = nv;
+ if (uv & 1 && uv == nv)
+ uv--; /* Round to even */
+ do {
+ unsigned dig = uv % 10;
+ *--p = '0' + dig;
+ } while (uv /= 10);
+ if (neg)
+ *--p = '-';
+ *len = endbuf - p;
+ return p;
+ }
+ return Nullch;
+}
+
+
/*
=for apidoc sv_vcatpvfn
bool has_utf8; /* has the result utf8? */
bool pat_utf8; /* the pattern is in utf8? */
SV *nsv = Nullsv;
+ /* Times 4: a decimal digit takes more than 3 binary digits.
+ * NV_DIG: mantissa takes than many decimal digits.
+ * Plus 32: Playing safe. */
+ char ebuf[IV_DIG * 4 + NV_DIG + 32];
+ /* large enough for "%#.#f" --chip */
+ /* what about long double NVs? --jhi */
has_utf8 = pat_utf8 = DO_UTF8(sv);
}
}
+#ifndef USE_LONG_DOUBLE
+ /* special-case "%.<number>[gf]" */
+ if ( 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');
+ if (pp - pat == patlen - 1) {
+ NV nv;
+
+ if (args)
+ nv = (NV)va_arg(*args, double);
+ else if (svix < svmax)
+ nv = SvNV(*svargs);
+ else
+ return;
+ if (*pp == 'g') {
+ if (digits < sizeof(ebuf) - NV_DIG - 10) { /* 0, point, slack */
+ Gconvert(nv, (int)digits, 0, ebuf);
+ sv_catpv(sv, ebuf);
+ if (*ebuf) /* May return an empty string for digits==0 */
+ return;
+ }
+ } else if (!digits) {
+ STRLEN l;
+
+ if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
+ sv_catpvn(sv, p, l);
+ return;
+ }
+ }
+ }
+ }
+#endif /* !USE_LONG_DOUBLE */
+
if (!args && svix < svmax && DO_UTF8(*svargs))
has_utf8 = TRUE;
char *eptr = Nullch;
STRLEN elen = 0;
- /* Times 4: a decimal digit takes more than 3 binary digits.
- * NV_DIG: mantissa takes than many decimal digits.
- * Plus 32: Playing safe. */
- char ebuf[IV_DIG * 4 + NV_DIG + 32];
- /* large enough for "%#.#f" --chip */
- /* what about long double NVs? --jhi */
-
SV *vecsv = Nullsv;
U8 *vecstr = Null(U8*);
STRLEN veclen = 0;
vecsv = va_arg(*args, SV*);
else
vecsv = (evix ? evix <= svmax : svix < svmax) ?
- svargs[ewix ? ewix-1 : svix++] : &PL_sv_undef;
+ svargs[evix ? evix-1 : svix++] : &PL_sv_undef;
dotstr = SvPVx(vecsv, dotstrlen);
if (DO_UTF8(vecsv))
is_utf8 = TRUE;
PL_efloatbuf[0] = '\0';
}
+ if ( !(width || left || plus || alt) && fill != '0'
+ && has_precis && intsize != 'q' ) { /* Shortcuts */
+ if ( c == 'g') {
+ Gconvert((NV)nv, (int)precis, 0, PL_efloatbuf);
+ if (*PL_efloatbuf) /* May return an empty string for digits==0 */
+ goto float_converted;
+ } else if ( c == 'f' && !precis) {
+ if ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen)))
+ break;
+ }
+ }
eptr = ebuf + sizeof ebuf;
*--eptr = '\0';
*--eptr = c;
#else
(void)sprintf(PL_efloatbuf, eptr, nv);
#endif
+ float_converted:
eptr = PL_efloatbuf;
elen = strlen(PL_efloatbuf);
break;
p = SvEND(sv);
*p = '\0';
}
- /* Don't use strchr() here, because eptr does not necessarily point */
- /* to a null-terminated string. E.g. with the format "%-10c", eptr */
- /* points to c (a single char on the stack), which makes strchr() */
- /* run amok over the stack until it eventually hits '\n' or '\0'. */
- if (left && ckWARN(WARN_PRINTF) && strnchr(eptr, '\n', elen) &&
+ /* Use memchr() instead of strchr(), as eptr is not guaranteed */
+ /* to point to a null-terminated string. */
+ if (left && ckWARN(WARN_PRINTF) && memchr(eptr, '\n', elen) &&
(PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF))
Perl_warner(aTHX_ packWARN(WARN_PRINTF),
"Newline in left-justified string for %sprintf",
longval = (long)POPBOOL(ss,ix);
TOPBOOL(nss,ix) = (bool)longval;
break;
+ case SAVEt_SET_SVFLAGS:
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup(sv, param);
+ break;
default:
Perl_croak(aTHX_ "panic: ss_dup inconsistency");
}
Create and return a new interpreter by cloning the current one.
-perl_clone takes these flags as paramters:
+perl_clone takes these flags as parameters:
CLONEf_COPY_STACKS - is used to, well, copy the stacks also,
without it we only clone the data and zero the stacks,
PL_markstack = 0;
PL_scopestack = 0;
PL_savestack = 0;
+ PL_savestack_ix = 0;
+ PL_savestack_max = -1;
PL_retstack = 0;
PL_sig_pending = 0;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
PL_markstack = 0;
PL_scopestack = 0;
PL_savestack = 0;
+ PL_savestack_ix = 0;
+ PL_savestack_max = -1;
PL_retstack = 0;
PL_sig_pending = 0;
Zero(&PL_debug_pad, 1, struct perl_debug_pad);
PL_debug = proto_perl->Idebug;
#ifdef USE_REENTRANT_API
+ /* XXX: things like -Dm will segfault here in perlio, but doing
+ * PERL_SET_CONTEXT(proto_perl);
+ * breaks too many other things
+ */
Perl_reentrant_init(aTHX);
#endif
PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
+ PL_hash_seed = proto_perl->Ihash_seed;
+ PL_rehash_seed = proto_perl->Irehash_seed;
PL_uudmap['M'] = 0; /* reinits on demand */
PL_bitcount = Nullch; /* reinits on demand */
PL_regstartp = (I32*)NULL;
PL_regendp = (I32*)NULL;
PL_reglastparen = (U32*)NULL;
+ PL_reglastcloseparen = (U32*)NULL;
PL_regtill = Nullch;
PL_reg_start_tmp = (char**)NULL;
PL_reg_start_tmpl = 0;
https://perl5.git.perl.org / perl5.git / blobdiff