Apda |SV* |newSVnv |NV n
Apda |SV* |newSVpv |NULLOK const char* s|STRLEN len
Apda |SV* |newSVpvn |NULLOK const char* s|STRLEN len
+Apda |SV* |newSVpvn_flags |NULLOK const char* s|STRLEN len|U32 flags
Apda |SV* |newSVhek |NULLOK const HEK *hek
Apda |SV* |newSVpvn_share |NULLOK const char* s|I32 len|U32 hash
Afpda |SV* |newSVpvf |NN const char* pat|...
#define newSVnv Perl_newSVnv
#define newSVpv Perl_newSVpv
#define newSVpvn Perl_newSVpvn
+#define newSVpvn_flags Perl_newSVpvn_flags
+#ifdef PERL_CORE
#define newSVhek Perl_newSVhek
+#endif
#define newSVpvn_share Perl_newSVpvn_share
#define newSVpvf Perl_newSVpvf
#define vnewSVpvf Perl_vnewSVpvf
#define newSVnv(a) Perl_newSVnv(aTHX_ a)
#define newSVpv(a,b) Perl_newSVpv(aTHX_ a,b)
#define newSVpvn(a,b) Perl_newSVpvn(aTHX_ a,b)
+#define newSVpvn_flags(a,b,c) Perl_newSVpvn_flags(aTHX_ a,b,c)
+#ifdef PERL_CORE
#define newSVhek(a) Perl_newSVhek(aTHX_ a)
+#endif
#define newSVpvn_share(a,b,c) Perl_newSVpvn_share(aTHX_ a,b,c)
#define vnewSVpvf(a,b) Perl_vnewSVpvf(aTHX_ a,b)
#define newSVrv(a,b) Perl_newSVrv(aTHX_ a,b)
SV* obj = mg->mg_obj;
if (!keysv) {
- keysv = sv_2mortal(newSVpvn(key, klen));
- if (flags & HVhek_UTF8)
- SvUTF8_on(keysv);
+ keysv = sv_2mortal(newSVpvn_utf8(key, klen,
+ flags & HVhek_UTF8));
}
mg->mg_obj = keysv; /* pass key */
/* FIXME should be able to skimp on the HE/HEK here when
HV_FETCH_JUST_SV is true. */
if (!keysv) {
- keysv = newSVpvn(key, klen);
- if (is_utf8) {
- SvUTF8_on(keysv);
- }
- } else {
+ keysv = newSVpvn_utf8(key, klen, is_utf8);
+ } else {
keysv = newSVsv(keysv);
}
sv = sv_newmortal();
if (keysv || is_utf8) {
if (!keysv) {
- keysv = newSVpvn(key, klen);
- SvUTF8_on(keysv);
+ keysv = newSVpvn_utf8(key, klen, TRUE);
} else {
keysv = newSVsv(keysv);
}
const bool save_taint = PL_tainted;
if (keysv || is_utf8) {
if (!keysv) {
- keysv = newSVpvn(key, klen);
- SvUTF8_on(keysv);
+ keysv = newSVpvn_utf8(key, klen, TRUE);
}
if (PL_tainting)
PL_tainted = SvTAINTED(keysv);
* It has the same effect as "sub name;", i.e. just a forward
* declaration! */
if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
- SV *const sv = newSVpvn(name,len);
- SvFLAGS(sv) |= flags & SVf_UTF8;
+ SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
return newSUB(start_subparse(FALSE, 0),
newSVOP(OP_CONST, 0, sv),
NULL, NULL);
=for hackers
Found in file sv.h
+=item newSVpvn_utf8
+X<newSVpvn_utf8>
+
+Creates a new SV and copies a string into it. If utf8 is true, calls
+C<SvUTF8_on> on the new SV. Implemented as a wrapper around C<newSVpvn_flags>.
+
+ SV* newSVpvn_utf8(NULLOK const char* s, STRLEN len, U32 utf8)
+
+=for hackers
+Found in file sv.h
+
=item SvCUR
X<SvCUR>
=for hackers
Found in file sv.c
+=item newSVpvn_flags
+X<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)
+
+ SV* newSVpvn_flags(const char* s, STRLEN len, U32 flags)
+
+=for hackers
+Found in file sv.c
+
=item newSVpvn_share
X<newSVpvn_share>
Otherwise I need to avoid calls to sv_pos_u2b(), which (dangerously)
will trigger magic and overloading again, as will fbm_instr()
*/
- big = sv_2mortal(newSVpvn(big_p, biglen));
- if (big_utf8)
- SvUTF8_on(big);
+ big = sv_2mortal(newSVpvn_utf8(big_p, biglen, big_utf8));
big_p = SvPVX(big);
}
if (SvGAMAGIC(little) || (is_index && !SvOK(little))) {
This is all getting to messy. The API isn't quite clean enough,
because data access has side effects.
*/
- little = sv_2mortal(newSVpvn(little_p, llen));
- if (little_utf8)
- SvUTF8_on(little);
+ little = sv_2mortal(newSVpvn_utf8(little_p, llen, little_utf8));
little_p = SvPVX(little);
}
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
+ dstr = newSVpvn_utf8(s, m-s, do_utf8);
if (make_mortal)
sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
/* skip the whitespace found last */
m++;
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
+ dstr = newSVpvn_utf8(s, m-s, do_utf8);
if (make_mortal)
sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
s = m;
}
/* keep track of how many bytes we skip over */
m = s;
s += UTF8SKIP(s);
- dstr = newSVpvn(m, s-m);
+ dstr = newSVpvn_utf8(m, s-m, TRUE);
if (make_mortal)
sv_2mortal(dstr);
- (void)SvUTF8_on(dstr);
PUSHs(dstr);
if (s >= strend)
;
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
+ dstr = newSVpvn_utf8(s, m-s, do_utf8);
if (make_mortal)
sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
(m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
csv, multiline ? FBMrf_MULTILINE : 0)) )
{
- dstr = newSVpvn(s, m-s);
+ dstr = newSVpvn_utf8(s, m-s, do_utf8);
if (make_mortal)
sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
strend = s + (strend - m);
}
m = RX_OFFS(rx)[0].start + orig;
- dstr = newSVpvn(s, m-s);
+ dstr = newSVpvn_utf8(s, m-s, do_utf8);
if (make_mortal)
sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
if (RX_NPARENS(rx)) {
I32 i;
parens that didn't match -- they should be set to
undef, not the empty string */
if (m >= orig && s >= orig) {
- dstr = newSVpvn(s, m-s);
+ dstr = newSVpvn_utf8(s, m-s, do_utf8);
}
else
dstr = &PL_sv_undef; /* undef, not "" */
if (make_mortal)
sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
}
}
/* keep field after final delim? */
if (s < strend || (iters && origlimit)) {
const STRLEN l = strend - s;
- dstr = newSVpvn(s, l);
+ dstr = newSVpvn_utf8(s, l, do_utf8);
if (make_mortal)
sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
iters++;
}
have_a_cow:
#endif
rxtainted |= RX_MATCH_TAINTED(rx);
- dstr = newSVpvn(m, s-m);
+ dstr = newSVpvn_utf8(m, s-m, DO_UTF8(TARG));
SAVEFREESV(dstr);
- if (DO_UTF8(TARG))
- SvUTF8_on(dstr);
PL_curpm = pm;
if (!c) {
register PERL_CONTEXT *cx;
by copying it to a temporary. */
STRLEN len;
const char *const pv = SvPV_const(*beglist, len);
- SV *const temp = sv_2mortal(newSVpvn(pv, len));
- if (SvUTF8(*beglist))
- SvUTF8_on(temp);
+ SV *const temp
+ = sv_2mortal(newSVpvn_flags(pv, len,
+ SvUTF8(*beglist)));
*beglist = temp;
}
count = DO_UTF8(*beglist) ?
__attribute__malloc__
__attribute__warn_unused_result__;
+PERL_CALLCONV SV* Perl_newSVpvn_flags(pTHX_ const char* s, STRLEN len, U32 flags)
+ __attribute__malloc__
+ __attribute__warn_unused_result__;
+
PERL_CALLCONV SV* Perl_newSVhek(pTHX_ const HEK *hek)
__attribute__malloc__
__attribute__warn_unused_result__;
/* store the word for dumping */ \
SV* tmp; \
if (OP(noper) != NOTHING) \
- tmp = newSVpvn(STRING(noper), STR_LEN(noper)); \
+ tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF); \
else \
- tmp = newSVpvn( "", 0 ); \
- if ( UTF ) SvUTF8_on( tmp ); \
+ tmp = newSVpvn_utf8( "", 0, UTF ); \
av_push( trie_words, tmp ); \
}); \
\
l -= old;
/* Get the added string: */
- last_str = newSVpvn(s + old, l);
- if (UTF)
- SvUTF8_on(last_str);
+ last_str = newSVpvn_utf8(s + old, l, UTF);
if (deltanext == 0 && pos_before == b) {
/* What was added is a constant string */
if (mincount > 1) {
}
if ( flags ) {
- SV* sv_name = sv_2mortal(Perl_newSVpvn(aTHX_ name_start,
- (int)(RExC_parse - name_start)));
- if (UTF)
- SvUTF8_on(sv_name);
+ SV* sv_name = sv_2mortal(newSVpvn_utf8(name_start,
+ (int)(RExC_parse - name_start), UTF));
if ( flags == REG_RSN_RETURN_NAME)
return sv_name;
else if (flags==REG_RSN_RETURN_DATA) {
if (!unicode_alternate)
unicode_alternate = newAV();
- sv = newSVpvn((char*)foldbuf, foldlen);
- SvUTF8_on(sv);
+ sv = newSVpvn_utf8((char*)foldbuf, foldlen,
+ TRUE);
av_push(unicode_alternate, sv);
}
}
* 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(pv1, cur1));
- if (SvUTF8(sv2)) SvUTF8_on(sv1);
+ sv1 = sv_2mortal(newSVpvn_flags(pv1, cur1, SvUTF8(sv2)));
}
pv1 = SvPV_const(sv1, cur1);
}
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 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
};
/*
+=for apidoc Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8
+
+Creates a new SV and copies a string into it. If utf8 is true, calls
+C<SvUTF8_on> on the new SV. Implemented as a wrapper around C<newSVpvn_flags>.
+
+=cut
+*/
+
+#define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
+
+/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
{
dVAR;
- SV * const sv = newSVpvn(start,len);
- if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len))
- SvUTF8_on(sv);
+ SV * const sv = newSVpvn_utf8(start, len,
+ UTF && !IN_BYTES
+ && is_utf8_string((const U8*)start, len));
return sv;
}
goto finish;
d = s;
if ( PL_hints & HINT_NEW_STRING ) {
- pv = sv_2mortal(newSVpvn(SvPVX_const(pv), len));
- if (SvUTF8(sv))
- SvUTF8_on(pv);
+ pv = sv_2mortal(newSVpvn_flags(SvPVX_const(pv), len, SvUTF8(sv)));
}
while (s < send) {
if (*s == '\\') {
/* Overloaded constants, nothing fancy: Convert to SVt_PV: */
STRLEN len;
const char * const p = SvPV_const(sv, len);
- SV * const nsv = newSVpvn(p, len);
- if (SvUTF8(sv))
- SvUTF8_on(nsv);
+ SV * const nsv = newSVpvn_flags(p, len, SvUTF8(sv));
SvREFCNT_dec(sv);
sv = nsv;
}
for (; !isSPACE(*d) && len; --len, ++d)
/**/;
}
- sv = newSVpvn(b, d-b);
- if (DO_UTF8(PL_lex_stuff))
- SvUTF8_on(sv);
+ sv = newSVpvn_utf8(b, d-b, DO_UTF8(PL_lex_stuff));
words = append_elem(OP_LIST, words,
newSVOP(OP_CONST, 0, tokeq(sv)));
}
*hook = NULL;
}
if (warn || message) {
- msg = newSVpvn(message, msglen);
- SvFLAGS(msg) |= utf8;
+ msg = newSVpvn_flags(message, msglen, utf8);
SvREADONLY_on(msg);
SAVEFREESV(msg);
}
projects / p5sagit/p5-mst-13.2.git / commitdiff