diff options
Diffstat (limited to 'sv.c')
| -rw-r--r-- | sv.c | 74 |
1 files changed, 38 insertions, 36 deletions
@@ -4344,7 +4344,7 @@ Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags) if (dutf8 != sutf8) { if (dutf8) { /* Not modifying source SV, so taking a temporary copy. */ - SV* const csv = sv_2mortal(newSVpvn(spv, slen)); + SV* const csv = newSVpvn_flags(spv, slen, SVs_TEMP); sv_utf8_upgrade(csv); spv = SvPV_const(csv, slen); @@ -6042,7 +6042,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) * invalidate pv1, so we may need to make a copy */ if (sv1 == sv2 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) { pv1 = SvPV_const(sv1, cur1); - sv1 = sv_2mortal(newSVpvn_flags(pv1, cur1, SvUTF8(sv2))); + sv1 = newSVpvn_flags(pv1, cur1, SVs_TEMP | SvUTF8(sv2)); } pv1 = SvPV_const(sv1, cur1); } @@ -6998,6 +6998,40 @@ Perl_sv_newmortal(pTHX) return sv; } + +/* +=for apidoc newSVpvn_flags + +Creates a new SV and copies a string into it. The reference count for the +SV is set to 1. Note that if C<len> is zero, Perl will create a zero length +string. You are responsible for ensuring that the source string is at least +C<len> bytes long. If the C<s> argument is NULL the new SV will be undefined. +Currently the only flag bits accepted are C<SVf_UTF8> and C<SVs_TEMP>. +If C<SVs_TEMP> is set, then C<sv2mortal()> is called on the result before +returning. If C<SVf_UTF8> is set, then it will be set on the new SV. +C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as + + #define newSVpvn_utf8(s, len, u) \ + newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) + +=cut +*/ + +SV * +Perl_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) +{ + dVAR; + register SV *sv; + + /* All the flags we don't support must be zero. + And we're new code so I'm going to assert this from the start. */ + assert(!(flags & ~(SVf_UTF8|SVs_TEMP))); + new_SV(sv); + sv_setpvn(sv,s,len); + SvFLAGS(sv) |= (flags & SVf_UTF8); + return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; +} + /* =for apidoc sv_2mortal @@ -7068,38 +7102,6 @@ Perl_newSVpvn(pTHX_ const char *s, STRLEN len) } /* -=for apidoc newSVpvn_flags - -Creates a new SV and copies a string into it. The reference count for the -SV is set to 1. Note that if C<len> is zero, Perl will create a zero length -string. You are responsible for ensuring that the source string is at least -C<len> bytes long. If the C<s> argument is NULL the new SV will be undefined. -Currently the only flag bit accepted is SVf_UTF8. If this is set, then it -will be set on the new SV. C<newSVpvn_utf8()> is a convenience wrapper for -this function, defined as - - #define newSVpvn_utf8(s, len, u) \ - newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) - -=cut -*/ - -SV * -Perl_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) -{ - dVAR; - register SV *sv; - - /* All the flags we don't support must be zero. - And we're new code so I'm going to assert this from the start. */ - assert(!(flags & ~SVf_UTF8)); - new_SV(sv); - sv_setpvn(sv,s,len); - SvFLAGS(sv) |= flags; - return sv; -} - -/* =for apidoc newSVhek Creates a new SV from the hash key structure. It will generate scalars that @@ -9529,7 +9531,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } else { const STRLEN old_elen = elen; - SV * const nsv = sv_2mortal(newSVpvn(eptr, elen)); + SV * const nsv = newSVpvn_flags(eptr, elen, SVs_TEMP); sv_utf8_upgrade(nsv); eptr = SvPVX_const(nsv); elen = SvCUR(nsv); @@ -11782,7 +11784,7 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding, XPUSHs(dsv); XPUSHs(ssv); XPUSHs(offsv = sv_2mortal(newSViv(*offset))); - XPUSHs(sv_2mortal(newSVpvn(tstr, tlen))); + XPUSHs(newSVpvn_flags(tstr, tlen, SVs_TEMP)); PUTBACK; call_method("cat_decode", G_SCALAR); SPAGAIN; |