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;
}
/*
SvTAINT(dstr);
}
+
+/*
+=for apidoc sv_set_undef
+
+Equivalent to C<sv_setsv(sv, &PL_sv_undef)>, but more efficient.
+Doesn't handle set magic.
+
+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.
+
+=cut
+*/
+
+void
+Perl_sv_set_undef(pTHX_ SV *sv)
+{
+ U32 type = SvTYPE(sv);
+
+ PERL_ARGS_ASSERT_SV_SET_UNDEF;
+
+ /* shortcut, NULL, IV, RV */
+
+ if (type <= SVt_IV) {
+ assert(!SvGMAGICAL(sv));
+ if (SvREADONLY(sv)) {
+ /* does undeffing PL_sv_undef count as modifying a read-only
+ * variable? Some XS code does this */
+ if (sv == &PL_sv_undef)
+ return;
+ Perl_croak_no_modify();
+ }
+
+ if (SvROK(sv)) {
+ if (SvWEAKREF(sv))
+ sv_unref_flags(sv, 0);
+ else {
+ SV *rv = SvRV(sv);
+ SvFLAGS(sv) = type; /* quickly turn off all flags */
+ SvREFCNT_dec_NN(rv);
+ return;
+ }
+ }
+ SvFLAGS(sv) = type; /* quickly turn off all flags */
+ return;
+ }
+
+ if (SvIS_FREED(sv))
+ Perl_croak(aTHX_ "panic: attempt to undefine a freed scalar %p",
+ (void *)sv);
+
+ SV_CHECK_THINKFIRST_COW_DROP(sv);
+
+ if (isGV_with_GP(sv))
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+ "Undefined value assigned to typeglob");
+ else
+ SvOK_off(sv);
+}
+
+
+
/*
=for apidoc sv_setsv_mg
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;
*/
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);
if (cnt > 0) {
/* if there is a separator */
if (rslen) {
- /* loop until we hit the end of the read-ahead buffer */
- while (cnt > 0) { /* this | eat */
- /* scan forward copying and searching for rslast as we go */
- cnt--;
- if ((*bp++ = *ptr++) == rslast) /* really | dust */
- goto thats_all_folks; /* screams | sed :-) */
- }
+ /* find next rslast */
+ STDCHAR *p;
+
+ /* shortcut common case of blank line */
+ cnt--;
+ if ((*bp++ = *ptr++) == rslast)
+ goto thats_all_folks;
+
+ p = (STDCHAR *)memchr(ptr, rslast, cnt);
+ if (p) {
+ SSize_t got = p - ptr + 1;
+ Copy(ptr, bp, got, STDCHAR);
+ ptr += got;
+ bp += got;
+ cnt -= got;
+ goto thats_all_folks;
+ }
+ Copy(ptr, bp, cnt, STDCHAR);
+ ptr += cnt;
+ bp += cnt;
+ cnt = 0;
}
else {
/* no separator, slurp the full buffer */
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
*/
PERL_ARGS_ASSERT_SV_SETREF_PV;
if (!pv) {
- sv_setsv(rv, &PL_sv_undef);
+ sv_set_undef(rv);
SvSETMAGIC(rv);
}
else
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);
}
parser->old_parser = NULL;
parser->stack = NULL;
parser->ps = NULL;
- parser->stack_size = 0;
+ parser->stack_max1 = 0;
/* XXX parser->stack->state = 0; */
/* XXX eventually, just Copy() most of the parser struct ? */
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);
{
PL_GCB_invlist = sv_dup_inc(proto_perl->IGCB_invlist, param);
PL_SB_invlist = sv_dup_inc(proto_perl->ISB_invlist, param);
PL_WB_invlist = sv_dup_inc(proto_perl->IWB_invlist, param);
+ PL_seen_deprecated_macro = hv_dup_inc(proto_perl->Iseen_deprecated_macro, param);
PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark, param);
PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper, param);
PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle, param);
https://perl5.git.perl.org / perl5.git / blobdiff