This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
regexec.c: Use safer utf8_hop
[perl5.git]
/
sv.c
diff --git
a/sv.c
b/sv.c
index
d7315b2
..
e9a4682
100644
(file)
--- a/
sv.c
+++ b/
sv.c
@@
-1071,10
+1071,10
@@
Perl_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
#if defined(DEBUGGING) && defined(PERL_GLOBAL_STRUCT)
dVAR;
#endif
#if defined(DEBUGGING) && defined(PERL_GLOBAL_STRUCT)
dVAR;
#endif
-#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT
_PRIVATE
)
+#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT)
static bool done_sanity_check;
static bool done_sanity_check;
- /* PERL_GLOBAL_STRUCT
_PRIVATE
cannot coexist with global
+ /* PERL_GLOBAL_STRUCT cannot coexist with global
* variables like done_sanity_check. */
if (!done_sanity_check) {
unsigned int i = SVt_LAST;
* variables like done_sanity_check. */
if (!done_sanity_check) {
unsigned int i = SVt_LAST;
@@
-9750,11
+9750,15
@@
Perl_newRV(pTHX_ SV *const sv)
Creates a new SV which is an exact duplicate of the original SV.
(Uses C<sv_setsv>.)
Creates a new SV which is an exact duplicate of the original SV.
(Uses C<sv_setsv>.)
+=for apidoc newSVsv_nomg
+
+Like C<newSVsv> but does not process get magic.
+
=cut
*/
SV *
=cut
*/
SV *
-Perl_newSVsv
(pTHX_ SV *const old
)
+Perl_newSVsv
_flags(pTHX_ SV *const old, I32 flags
)
{
SV *sv;
{
SV *sv;
@@
-9765,11
+9769,10
@@
Perl_newSVsv(pTHX_ SV *const old)
return NULL;
}
/* Do this here, otherwise we leak the new SV if this croaks. */
return NULL;
}
/* Do this here, otherwise we leak the new SV if this croaks. */
- SvGETMAGIC(old);
+ if (flags & SV_GMAGIC)
+ SvGETMAGIC(old);
new_SV(sv);
new_SV(sv);
- /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
- with SvTEMP_off and SvTEMP_on round a call to sv_setsv. */
- sv_setsv_flags(sv, old, SV_NOSTEAL);
+ sv_setsv_flags(sv, old, flags & ~SV_GMAGIC);
return sv;
}
return sv;
}
@@
-10869,8
+10872,8
@@
Perl_sv_catpvf_mg_nocontext(SV *const sv, const char *const pat, ...)
/*
=for apidoc sv_catpvf
/*
=for apidoc sv_catpvf
-Processes its arguments like C<s
v_catpvfn
>, and appends the formatted
-output to an SV. As with C<sv_catpvfn> called with a non-null C-style
+Processes its arguments like C<s
printf
>, and appends the formatted
+output to an SV. As with C<sv_
v
catpvfn> called with a non-null C-style
variable argument list, argument reordering is not supported.
If the appended data contains "wide" characters
(including, but not limited to, SVs with a UTF-8 PV formatted with C<%s>,
variable argument list, argument reordering is not supported.
If the appended data contains "wide" characters
(including, but not limited to, SVs with a UTF-8 PV formatted with C<%s>,
@@
-10896,7
+10899,7
@@
Perl_sv_catpvf(pTHX_ SV *const sv, const char *const pat, ...)
/*
=for apidoc sv_vcatpvf
/*
=for apidoc sv_vcatpvf
-Processes its arguments like C<sv_catpvfn> called with a non-null C-style
+Processes its arguments like C<sv_
v
catpvfn> called with a non-null C-style
variable argument list, and appends the formatted output
to an SV. Does not handle 'set' magic. See C<L</sv_vcatpvf_mg>>.
variable argument list, and appends the formatted output
to an SV. Does not handle 'set' magic. See C<L</sv_vcatpvf_mg>>.
@@
-12044,7
+12047,7
@@
Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
if (*q == '$') {
if (args)
Perl_croak_nocontext(
if (*q == '$') {
if (args)
Perl_croak_nocontext(
- "Cannot yet reorder sv_catpvfn() arguments from va_list");
+ "Cannot yet reorder sv_
v
catpvfn() arguments from va_list");
++q;
efix = (Size_t)width;
width = 0;
++q;
efix = (Size_t)width;
width = 0;
@@
-12112,7
+12115,7
@@
Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
if (*q++ == '$') {
if (args)
Perl_croak_nocontext(
if (*q++ == '$') {
if (args)
Perl_croak_nocontext(
- "Cannot yet reorder sv_catpvfn() arguments from va_list");
+ "Cannot yet reorder sv_
v
catpvfn() arguments from va_list");
no_redundant_warning = TRUE;
} else
goto unknown;
no_redundant_warning = TRUE;
} else
goto unknown;
@@
-12197,7
+12200,7
@@
Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
if (*q++ == '$') {
if (args)
Perl_croak_nocontext(
if (*q++ == '$') {
if (args)
Perl_croak_nocontext(
- "Cannot yet reorder sv_catpvfn() arguments from va_list");
+ "Cannot yet reorder sv_
v
catpvfn() arguments from va_list");
no_redundant_warning = TRUE;
} else
goto unknown;
no_redundant_warning = TRUE;
} else
goto unknown;
@@
-15575,16
+15578,9
@@
perl_clone_using(PerlInterpreter *proto_perl, UV flags,
if (PL_my_cxt_size) {
Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
Copy(proto_perl->Imy_cxt_list, PL_my_cxt_list, PL_my_cxt_size, void *);
if (PL_my_cxt_size) {
Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
Copy(proto_perl->Imy_cxt_list, PL_my_cxt_list, PL_my_cxt_size, void *);
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
- Newx(PL_my_cxt_keys, PL_my_cxt_size, const char *);
- Copy(proto_perl->Imy_cxt_keys, PL_my_cxt_keys, PL_my_cxt_size, char *);
-#endif
}
else {
PL_my_cxt_list = (void**)NULL;
}
else {
PL_my_cxt_list = (void**)NULL;
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
- PL_my_cxt_keys = (const char**)NULL;
-#endif
}
PL_modglobal = hv_dup_inc(proto_perl->Imodglobal, param);
PL_custom_op_names = hv_dup_inc(proto_perl->Icustom_op_names,param);
}
PL_modglobal = hv_dup_inc(proto_perl->Imodglobal, param);
PL_custom_op_names = hv_dup_inc(proto_perl->Icustom_op_names,param);