summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dump.c7
-rw-r--r--embed.fnc8
-rw-r--r--embed.h5
-rw-r--r--global.sym4
-rw-r--r--handy.h47
-rw-r--r--hv.c5
-rw-r--r--hv.h3
-rw-r--r--proto.h32
-rw-r--r--sv.c32
-rw-r--r--sv.h4
-rw-r--r--toke.c33
-rw-r--r--util.c19
12 files changed, 194 insertions, 5 deletions
diff --git a/dump.c b/dump.c
index 832c60c6c2..2fca2c38ef 100644
--- a/dump.c
+++ b/dump.c
@@ -2396,6 +2396,13 @@ Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv)
}
char *
+Perl_sv_catxmlpv(pTHX_ SV *dsv, const char *pv, int utf8)
+{
+ PERL_ARGS_ASSERT_SV_CATXMLPV;
+ return sv_catxmlpvn(dsv, pv, strlen(pv), utf8);
+}
+
+char *
Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
{
unsigned int c;
diff --git a/embed.fnc b/embed.fnc
index 0ff6d2bf96..8add403358 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -237,6 +237,8 @@ Apd |HV* |cop_hints_2hv |NN const COP *cop
Apd |SV* |cop_hints_fetchpvn|NN const COP *cop|NN const char *key \
|STRLEN klen|int flags|U32 hash
Amd |SV* |cop_hints_fetchpvs|NN const COP *cop|NN const char *const key
+Amd |SV* |cop_hints_fetchpv|NN const COP *cop|NN const char *const key \
+ |int flags|U32 hash
Amd |SV* |cop_hints_fetchsv|NN const COP *cop|NN SV *keysv|U32 hash
: Used in op.c and perl.c
pM |PERL_CONTEXT* |create_eval_scope|U32 flags
@@ -621,6 +623,7 @@ p |void |lex_start |NULLOK SV* line|NULLOK PerlIO *rsfp|bool new_filter
AMpd |bool |lex_bufutf8
AMpd |char* |lex_grow_linestr|STRLEN len
AMpd |void |lex_stuff_pvn |NN const char* pv|STRLEN len|U32 flags
+AMpd |void |lex_stuff_pv |NN const char* pv|U32 flags
AMpd |void |lex_stuff_sv |NN SV* sv|U32 flags
AMpd |void |lex_unstuff |NN char* ptr
AMpd |void |lex_read_to |NN char* ptr
@@ -833,6 +836,7 @@ Apda |SV* |newSVpvn |NULLOK const char *const s|const STRLEN len
Apda |SV* |newSVpvn_flags |NULLOK const char *const s|const STRLEN len|const U32 flags
Apda |SV* |newSVhek |NULLOK const HEK *const hek
Apda |SV* |newSVpvn_share |NULLOK const char* s|I32 len|U32 hash
+Apda |SV* |newSVpv_share |NULLOK const char* s|U32 hash
Afpda |SV* |newSVpvf |NN const char *const pat|...
Apa |SV* |vnewSVpvf |NN const char *const pat|NULLOK va_list *const args
Apd |SV* |newSVrv |NN SV *const rv|NULLOK const char *const classname
@@ -1024,6 +1028,7 @@ Apda |char* |savepv |NULLOK const char* pv
Apda |char* |savepvn |NULLOK const char* pv|I32 len
Apda |char* |savesharedpv |NULLOK const char* pv
Apda |char* |savesharedpvn |NN const char *const pv|const STRLEN len
+Apda |char* |savesharedsvpv |NN SV *sv
Apda |char* |savesvpv |NN SV* sv
Ap |void |savestack_grow
Ap |void |savestack_grow_cnt |I32 need
@@ -1993,6 +1998,8 @@ START_EXTERN_C
Apd |void |sv_setsv_flags |NN SV *dstr|NULLOK SV *sstr|const I32 flags
Apd |void |sv_catpvn_flags|NN SV *const dstr|NN const char *sstr|const STRLEN len \
|const I32 flags
+Apd |void |sv_catpv_flags |NN SV *dstr|NN const char *sstr \
+ |const I32 flags
Apd |void |sv_catsv_flags |NN SV *const dsv|NULLOK SV *const ssv|const I32 flags
Apmd |STRLEN |sv_utf8_upgrade_flags|NN SV *const sv|const I32 flags
Ap |STRLEN |sv_utf8_upgrade_flags_grow|NN SV *const sv|const I32 flags|STRLEN extra
@@ -2283,6 +2290,7 @@ Mp |void |xmldump_form |NN const GV* gv
Mp |void |xmldump_eval
Mp |char* |sv_catxmlsv |NN SV *dsv|NN SV *ssv
Mp |char* |sv_catxmlpvn |NN SV *dsv|NN const char *pv|STRLEN len|int utf8
+Mp |char* |sv_catxmlpv |NN SV *dsv|NN const char *pv|int utf8
Mp |char* |sv_xmlpeek |NN SV* sv
Mp |void |do_pmop_xmldump|I32 level|NN PerlIO *file \
|NULLOK const PMOP *pm
diff --git a/embed.h b/embed.h
index 3d6e6aef78..839709531e 100644
--- a/embed.h
+++ b/embed.h
@@ -452,6 +452,7 @@
#define lex_bufutf8() Perl_lex_bufutf8(aTHX)
#define lex_grow_linestr(a) Perl_lex_grow_linestr(aTHX_ a)
#define lex_stuff_pvn(a,b,c) Perl_lex_stuff_pvn(aTHX_ a,b,c)
+#define lex_stuff_pv(a,b) Perl_lex_stuff_pv(aTHX_ a,b)
#define lex_stuff_sv(a,b) Perl_lex_stuff_sv(aTHX_ a,b)
#define lex_unstuff(a) Perl_lex_unstuff(aTHX_ a)
#define lex_read_to(a) Perl_lex_read_to(aTHX_ a)
@@ -670,6 +671,7 @@
#define newSVpvn_flags(a,b,c) Perl_newSVpvn_flags(aTHX_ a,b,c)
#define newSVhek(a) Perl_newSVhek(aTHX_ a)
#define newSVpvn_share(a,b,c) Perl_newSVpvn_share(aTHX_ a,b,c)
+#define newSVpv_share(a,b) Perl_newSVpv_share(aTHX_ a,b)
#ifndef PERL_IMPLICIT_CONTEXT
#define newSVpvf Perl_newSVpvf
#endif
@@ -854,6 +856,7 @@
#define savepvn(a,b) Perl_savepvn(aTHX_ a,b)
#define savesharedpv(a) Perl_savesharedpv(aTHX_ a)
#define savesharedpvn(a,b) Perl_savesharedpvn(aTHX_ a,b)
+#define savesharedsvpv(a) Perl_savesharedsvpv(aTHX_ a)
#define savesvpv(a) Perl_savesvpv(aTHX_ a)
#define savestack_grow() Perl_savestack_grow(aTHX)
#define savestack_grow_cnt(a) Perl_savestack_grow_cnt(aTHX_ a)
@@ -1746,6 +1749,7 @@
#endif
#define sv_setsv_flags(a,b,c) Perl_sv_setsv_flags(aTHX_ a,b,c)
#define sv_catpvn_flags(a,b,c,d) Perl_sv_catpvn_flags(aTHX_ a,b,c,d)
+#define sv_catpv_flags(a,b,c) Perl_sv_catpv_flags(aTHX_ a,b,c)
#define sv_catsv_flags(a,b,c) Perl_sv_catsv_flags(aTHX_ a,b,c)
#define sv_utf8_upgrade_flags_grow(a,b,c) Perl_sv_utf8_upgrade_flags_grow(aTHX_ a,b,c)
#define sv_pvn_force_flags(a,b,c) Perl_sv_pvn_force_flags(aTHX_ a,b,c)
@@ -2043,6 +2047,7 @@
#define xmldump_eval() Perl_xmldump_eval(aTHX)
#define sv_catxmlsv(a,b) Perl_sv_catxmlsv(aTHX_ a,b)
#define sv_catxmlpvn(a,b,c,d) Perl_sv_catxmlpvn(aTHX_ a,b,c,d)
+#define sv_catxmlpv(a,b,c) Perl_sv_catxmlpv(aTHX_ a,b,c)
#define sv_xmlpeek(a) Perl_sv_xmlpeek(aTHX_ a)
#define do_pmop_xmldump(a,b,c) Perl_do_pmop_xmldump(aTHX_ a,b,c)
#define pmop_xmldump(a) Perl_pmop_xmldump(aTHX_ a)
diff --git a/global.sym b/global.sym
index 6c4c57028b..f191be4f70 100644
--- a/global.sym
+++ b/global.sym
@@ -269,6 +269,7 @@ Perl_lex_end
Perl_lex_bufutf8
Perl_lex_grow_linestr
Perl_lex_stuff_pvn
+Perl_lex_stuff_pv
Perl_lex_stuff_sv
Perl_lex_unstuff
Perl_lex_read_to
@@ -383,6 +384,7 @@ Perl_newSVpvn
Perl_newSVpvn_flags
Perl_newSVhek
Perl_newSVpvn_share
+Perl_newSVpv_share
Perl_newSVpvf
Perl_vnewSVpvf
Perl_newSVrv
@@ -474,6 +476,7 @@ Perl_savepv
Perl_savepvn
Perl_savesharedpv
Perl_savesharedpvn
+Perl_savesharedsvpv
Perl_savesvpv
Perl_savestack_grow
Perl_savestack_grow_cnt
@@ -764,6 +767,7 @@ Perl_Slab_Free
Perl_sv_del_backref
Perl_sv_setsv_flags
Perl_sv_catpvn_flags
+Perl_sv_catpv_flags
Perl_sv_catsv_flags
Perl_sv_utf8_upgrade_flags_grow
Perl_sv_pvn_force_flags
diff --git a/handy.h b/handy.h
index d82f532e63..d966bfe0b6 100644
--- a/handy.h
+++ b/handy.h
@@ -289,17 +289,41 @@ pair.
Like C<newSVpvn_share>, but takes a literal string instead of a string/length
pair and omits the hash parameter.
+=for apidoc Am|void|sv_catpvs_flags|SV* sv|const char* s|I32 flags
+Like C<sv_catpvn_flags>, but takes a literal string instead of a
+string/length pair.
+
+=for apidoc Am|void|sv_catpvs_nomg|SV* sv|const char* s
+Like C<sv_catpvn_nomg>, but takes a literal string instead of a
+string/length pair.
+
=for apidoc Am|void|sv_catpvs|SV* sv|const char* s
Like C<sv_catpvn>, but takes a literal string instead of a string/length pair.
+=for apidoc Am|void|sv_catpvs_mg|SV* sv|const char* s
+Like C<sv_catpvn_mg>, but takes a literal string instead of a
+string/length pair.
+
=for apidoc Am|void|sv_setpvs|SV* sv|const char* s
Like C<sv_setpvn>, but takes a literal string instead of a string/length pair.
+=for apidoc Am|void|sv_setpvs_mg|SV* sv|const char* s
+Like C<sv_setpvn_mg>, but takes a literal string instead of a
+string/length pair.
+
+=for apidoc Am|SV *|sv_setref_pvs|const char* s
+Like C<sv_setref_pvn>, but takes a literal string instead of a
+string/length pair.
+
=head1 Memory Management
=for apidoc Ama|char*|savepvs|const char* s
Like C<savepvn>, but takes a literal string instead of a string/length pair.
+=for apidoc Ama|char*|savesharedpvs|const char* s
+A version of C<savepvs()> which allocates the duplicate string in memory
+which is shared between threads.
+
=head1 GV Functions
=for apidoc Am|HV*|gv_stashpvs|const char* name|I32 create
@@ -337,11 +361,28 @@ string/length pair.
#define newSVpvs_flags(str,flags) \
Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN(str), flags)
#define newSVpvs_share(str) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(str), 0)
-#define sv_catpvs(sv, str) Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), SV_GMAGIC)
+#define sv_catpvs_flags(sv, str, flags) \
+ Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), flags)
+#define sv_catpvs_nomg(sv, str) \
+ Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), 0)
+#define sv_catpvs(sv, str) \
+ Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), SV_GMAGIC)
+#define sv_catpvs_mg(sv, str) \
+ Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), SV_GMAGIC|SV_SMAGIC)
#define sv_setpvs(sv, str) Perl_sv_setpvn(aTHX_ sv, STR_WITH_LEN(str))
+#define sv_setpvs_mg(sv, str) Perl_sv_setpvn_mg(aTHX_ sv, STR_WITH_LEN(str))
+#define sv_setref_pvs(rv, classname, str) \
+ Perl_sv_setref_pvn(aTHX_ rv, classname, STR_WITH_LEN(str))
#define savepvs(str) Perl_savepvn(aTHX_ STR_WITH_LEN(str))
-#define gv_stashpvs(str, create) Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str), create)
-#define gv_fetchpvs(namebeg, add, sv_type) Perl_gv_fetchpvn_flags(aTHX_ STR_WITH_LEN(namebeg), add, sv_type)
+#define savesharedpvs(str) Perl_savesharedpvn(aTHX_ STR_WITH_LEN(str))
+#define gv_stashpvs(str, create) \
+ Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str), create)
+#define gv_fetchpvs(namebeg, add, sv_type) \
+ Perl_gv_fetchpvn_flags(aTHX_ STR_WITH_LEN(namebeg), add, sv_type)
+#define gv_fetchpvn(namebeg, len, add, sv_type) \
+ Perl_gv_fetchpvn_flags(aTHX_ namebeg, len, add, sv_type)
+#define sv_catxmlpvs(dsv, str, utf8) \
+ Perl_sv_catxmlpvn(aTHX_ dsv, STR_WITH_LEN(str), utf8)
#define hv_fetchs(hv,key,lval) \
((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \
(lval) ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \
diff --git a/hv.c b/hv.c
index 590524c47d..a04e4c51c1 100644
--- a/hv.c
+++ b/hv.c
@@ -2650,6 +2650,11 @@ if the entry isn't there.
See L</cop_hints_fetchsv>. If C<flags> includes C<HVhek_UTF8>, C<key> is
in UTF-8.
+=for apidoc cop_hints_fetchpv
+
+See L</cop_hints_fetchsv>. If C<flags> includes C<HVhek_UTF8>, C<key> is
+in UTF-8.
+
=for apidoc cop_hints_fetchpvs
See L</cop_hints_fetchpvn>. This is a macro that takes a constant string
diff --git a/hv.h b/hv.h
index 61d0ad945e..62646b3965 100644
--- a/hv.h
+++ b/hv.h
@@ -454,6 +454,9 @@ C<SV*>.
Perl_cop_hints_fetchpvn(aTHX_ (cop), SvPV_nolen(keysv), SvCUR(keysv), \
(SvUTF8(keysv) ? HVhek_UTF8 : 0), (hash))
+#define cop_hints_fetchpv(cop, key, flags, hash) \
+ Perl_cop_hints_fetchpvn(aTHX_ (cop), key, strlen(key), (flags), (hash))
+
#define cop_hints_fetchpvs(cop, key) \
Perl_cop_hints_fetchpvn(aTHX_ (cop), STR_WITH_LEN(key), 0, 0)
diff --git a/proto.h b/proto.h
index f52c8f1373..e489bd192e 100644
--- a/proto.h
+++ b/proto.h
@@ -335,6 +335,10 @@ PERL_CALLCONV SV* Perl_cop_hints_fetchpvn(pTHX_ const COP *cop, const char *key,
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2); */
+/* PERL_CALLCONV SV* cop_hints_fetchpv(pTHX_ const COP *cop, const char *const key, int flags, U32 hash)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2); */
+
/* PERL_CALLCONV SV* cop_hints_fetchsv(pTHX_ const COP *cop, SV *keysv, U32 hash)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2); */
@@ -1572,6 +1576,11 @@ PERL_CALLCONV void Perl_lex_stuff_pvn(pTHX_ const char* pv, STRLEN len, U32 flag
#define PERL_ARGS_ASSERT_LEX_STUFF_PVN \
assert(pv)
+PERL_CALLCONV void Perl_lex_stuff_pv(pTHX_ const char* pv, U32 flags)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_LEX_STUFF_PV \
+ assert(pv)
+
PERL_CALLCONV void Perl_lex_stuff_sv(pTHX_ SV* sv, U32 flags)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_LEX_STUFF_SV \
@@ -2415,6 +2424,10 @@ PERL_CALLCONV SV* Perl_newSVpvn_share(pTHX_ const char* s, I32 len, U32 hash)
__attribute__malloc__
__attribute__warn_unused_result__;
+PERL_CALLCONV SV* Perl_newSVpv_share(pTHX_ const char* s, U32 hash)
+ __attribute__malloc__
+ __attribute__warn_unused_result__;
+
PERL_CALLCONV SV* Perl_newSVpvf(pTHX_ const char *const pat, ...)
__attribute__malloc__
__attribute__warn_unused_result__
@@ -2952,6 +2965,13 @@ PERL_CALLCONV char* Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN
#define PERL_ARGS_ASSERT_SAVESHAREDPVN \
assert(pv)
+PERL_CALLCONV char* Perl_savesharedsvpv(pTHX_ SV *sv)
+ __attribute__malloc__
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SAVESHAREDSVPV \
+ assert(sv)
+
PERL_CALLCONV char* Perl_savesvpv(pTHX_ SV* sv)
__attribute__malloc__
__attribute__warn_unused_result__
@@ -6010,6 +6030,12 @@ PERL_CALLCONV void Perl_sv_catpvn_flags(pTHX_ SV *const dstr, const char *sstr,
#define PERL_ARGS_ASSERT_SV_CATPVN_FLAGS \
assert(dstr); assert(sstr)
+PERL_CALLCONV void Perl_sv_catpv_flags(pTHX_ SV *dstr, const char *sstr, const I32 flags)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SV_CATPV_FLAGS \
+ assert(dstr); assert(sstr)
+
PERL_CALLCONV void Perl_sv_catsv_flags(pTHX_ SV *const dsv, SV *const ssv, const I32 flags)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_SV_CATSV_FLAGS \
@@ -6563,6 +6589,12 @@ PERL_CALLCONV char* Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len,
#define PERL_ARGS_ASSERT_SV_CATXMLPVN \
assert(dsv); assert(pv)
+PERL_CALLCONV char* Perl_sv_catxmlpv(pTHX_ SV *dsv, const char *pv, int utf8)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SV_CATXMLPV \
+ assert(dsv); assert(pv)
+
PERL_CALLCONV char* Perl_sv_xmlpeek(pTHX_ SV* sv)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_SV_XMLPEEK \
diff --git a/sv.c b/sv.c
index 351df2dfd2..58d0b40dc0 100644
--- a/sv.c
+++ b/sv.c
@@ -4858,6 +4858,24 @@ Perl_sv_catpv(pTHX_ register SV *const sv, register const char *ptr)
}
/*
+=for apidoc sv_catpv_flags
+
+Concatenates the string onto the end of the string which is in the SV.
+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 the SVs if appropriate, else not.
+
+=cut
+*/
+
+void
+Perl_sv_catpv_flags(pTHX_ SV *dstr, const char *sstr, I32 flags)
+{
+ PERL_ARGS_ASSERT_SV_CATPV_FLAGS;
+ sv_catpvn_flags(dstr, sstr, strlen(sstr), flags);
+}
+
+/*
=for apidoc sv_catpv_mg
Like C<sv_catpv>, but also handles 'set' magic.
@@ -8112,6 +8130,20 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
return sv;
}
+/*
+=for apidoc newSVpv_share
+
+Like C<newSVpvn_share>, but takes a nul-terminated string instead of a
+string/length pair.
+
+=cut
+*/
+
+SV *
+Perl_newSVpv_share(pTHX_ const char *src, U32 hash)
+{
+ return newSVpvn_share(src, strlen(src), hash);
+}
#if defined(PERL_IMPLICIT_CONTEXT)
diff --git a/sv.h b/sv.h
index be41ac1a2e..2f03bfc8d0 100644
--- a/sv.h
+++ b/sv.h
@@ -1517,6 +1517,9 @@ scalar.
=for apidoc Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len
Like C<sv_catpvn> but doesn't process magic.
+=for apidoc Am|void|sv_catpv_nomg|SV* sv|const char* ptr
+Like C<sv_catpv> but doesn't process magic.
+
=for apidoc Am|void|sv_setsv_nomg|SV* dsv|SV* ssv
Like C<sv_setsv> but doesn't process magic.
@@ -1817,6 +1820,7 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect
#define sv_utf8_upgrade_flags(sv, flags) sv_utf8_upgrade_flags_grow(sv, flags, 0)
#define sv_utf8_upgrade_nomg(sv) sv_utf8_upgrade_flags(sv, 0)
#define sv_catpvn_nomg(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, 0)
+#define sv_catpv_nomg(dsv, sstr) sv_catpv_flags(dsv, sstr, 0)
#define sv_setsv(dsv, ssv) \
sv_setsv_flags(dsv, ssv, SV_GMAGIC|SV_DO_COW_SVSETSV)
#define sv_setsv_nomg(dsv, ssv) sv_setsv_flags(dsv, ssv, SV_DO_COW_SVSETSV)
diff --git a/toke.c b/toke.c
index 961866bba0..dd49c3cdba 100644
--- a/toke.c
+++ b/toke.c
@@ -923,7 +923,7 @@ at I<pv>. These octets are interpreted as either UTF-8 or Latin-1,
according to whether the C<LEX_STUFF_UTF8> flag is set in I<flags>.
The characters are recoded for the lexer buffer, according to how the
buffer is currently being interpreted (L</lex_bufutf8>). If a string
-to be interpreted is available as a Perl scalar, the L</lex_stuff_sv>
+to be inserted is available as a Perl scalar, the L</lex_stuff_sv>
function is more convenient.
=cut
@@ -1015,6 +1015,35 @@ Perl_lex_stuff_pvn(pTHX_ const char *pv, STRLEN len, U32 flags)
}
/*
+=for apidoc Amx|void|lex_stuff_pv|const char *pv|U32 flags
+
+Insert characters into the lexer buffer (L</PL_parser-E<gt>linestr>),
+immediately after the current lexing point (L</PL_parser-E<gt>bufptr>),
+reallocating the buffer if necessary. This means that lexing code that
+runs later will see the characters as if they had appeared in the input.
+It is not recommended to do this as part of normal parsing, and most
+uses of this facility run the risk of the inserted characters being
+interpreted in an unintended manner.
+
+The string to be inserted is represented by octets starting at I<pv>
+and continuing to the first nul. These octets are interpreted as either
+UTF-8 or Latin-1, according to whether the C<LEX_STUFF_UTF8> flag is set
+in I<flags>. The characters are recoded for the lexer buffer, according
+to how the buffer is currently being interpreted (L</lex_bufutf8>).
+If it is not convenient to nul-terminate a string to be inserted, the
+L</lex_stuff_pvn> function is more appropriate.
+
+=cut
+*/
+
+void
+Perl_lex_stuff_pv(pTHX_ const char *pv, U32 flags)
+{
+ PERL_ARGS_ASSERT_LEX_STUFF_PV;
+ lex_stuff_pvn(pv, strlen(pv), flags);
+}
+
+/*
=for apidoc Amx|void|lex_stuff_sv|SV *sv|U32 flags
Insert characters into the lexer buffer (L</PL_parser-E<gt>linestr>),
@@ -1027,7 +1056,7 @@ interpreted in an unintended manner.
The string to be inserted is the string value of I<sv>. The characters
are recoded for the lexer buffer, according to how the buffer is currently
-being interpreted (L</lex_bufutf8>). If a string to be interpreted is
+being interpreted (L</lex_bufutf8>). If a string to be inserted is
not already a Perl scalar, the L</lex_stuff_pvn> function avoids the
need to construct a scalar.
diff --git a/util.c b/util.c
index bce196a364..bed4c64629 100644
--- a/util.c
+++ b/util.c
@@ -1087,6 +1087,25 @@ Perl_savesvpv(pTHX_ SV *sv)
return (char *) CopyD(pv,newaddr,len,char);
}
+/*
+=for apidoc savesharedsvpv
+
+A version of C<savesharedpv()> which allocates the duplicate string in
+memory which is shared between threads.
+
+=cut
+*/
+
+char *
+Perl_savesharedsvpv(pTHX_ SV *sv)
+{
+ STRLEN len;
+ const char * const pv = SvPV_const(sv, len);
+
+ PERL_ARGS_ASSERT_SAVESHAREDSVPV;
+
+ return savesharedpvn(pv, len);
+}
/* the SV for Perl_form() and mess() is not kept in an arena */