diff --git a/embed.fnc b/embed.fnc index c3732052c740..03fd8eb0bc8e 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2114,7 +2114,9 @@ ApmdbR |char* |sv_pvutf8 |NN SV *sv ApmdbR |char* |sv_pvbyte |NN SV *sv Apmdb |STRLEN |sv_utf8_upgrade|NN SV *sv Amd |STRLEN |sv_utf8_upgrade_nomg|NN SV *sv -Apd |bool |sv_utf8_downgrade|NN SV *const sv|const bool fail_ok +Apdmb |bool |sv_utf8_downgrade|NN SV *const sv|const bool fail_ok +Amd |bool |sv_utf8_downgrade_nomg|NN SV *const sv|const bool fail_ok +Apd |bool |sv_utf8_downgrade_flags|NN SV *const sv|const bool fail_ok|const U32 flags Apd |void |sv_utf8_encode |NN SV *const sv Apd |bool |sv_utf8_decode |NN SV *const sv Apdmb |void |sv_force_normal|NN SV *sv diff --git a/embed.h b/embed.h index 78659236b447..5f7cb5f58f6e 100644 --- a/embed.h +++ b/embed.h @@ -854,7 +854,7 @@ #define sv_upgrade(a,b) Perl_sv_upgrade(aTHX_ a,b) #define sv_usepvn_flags(a,b,c,d) Perl_sv_usepvn_flags(aTHX_ a,b,c,d) #define sv_utf8_decode(a) Perl_sv_utf8_decode(aTHX_ a) -#define sv_utf8_downgrade(a,b) Perl_sv_utf8_downgrade(aTHX_ a,b) +#define sv_utf8_downgrade_flags(a,b,c) Perl_sv_utf8_downgrade_flags(aTHX_ a,b,c) #define sv_utf8_encode(a) Perl_sv_utf8_encode(aTHX_ a) #define sv_utf8_upgrade_flags_grow(a,b,c) Perl_sv_utf8_upgrade_flags_grow(aTHX_ a,b,c) #ifndef NO_MATHOMS diff --git a/mathoms.c b/mathoms.c index e2dc11c142e1..645029131789 100644 --- a/mathoms.c +++ b/mathoms.c @@ -1761,6 +1761,14 @@ Perl_newSVsv(pTHX_ SV *const old) return newSVsv(old); } +bool +Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok) +{ + PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE; + + return sv_utf8_downgrade(sv, fail_ok); +} + #endif /* NO_MATHOMS */ /* diff --git a/proto.h b/proto.h index 29a1e0cb6c3f..59db1d214f80 100644 --- a/proto.h +++ b/proto.h @@ -3701,9 +3701,15 @@ PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len); PERL_CALLCONV bool Perl_sv_utf8_decode(pTHX_ SV *const sv); #define PERL_ARGS_ASSERT_SV_UTF8_DECODE \ assert(sv) +#ifndef NO_MATHOMS PERL_CALLCONV bool Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok); #define PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE \ assert(sv) +#endif +PERL_CALLCONV bool Perl_sv_utf8_downgrade_flags(pTHX_ SV *const sv, const bool fail_ok, const U32 flags); +#define PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE_FLAGS \ + assert(sv) +/* PERL_CALLCONV bool sv_utf8_downgrade_nomg(pTHX_ SV *const sv, const bool fail_ok); */ PERL_CALLCONV void Perl_sv_utf8_encode(pTHX_ SV *const sv); #define PERL_ARGS_ASSERT_SV_UTF8_ENCODE \ assert(sv) diff --git a/sv.c b/sv.c index df0b601650ca..2212ba57a1b6 100644 --- a/sv.c +++ b/sv.c @@ -3649,19 +3649,31 @@ true, croaks. This is not a general purpose Unicode to byte encoding interface: use the C extension for that. +This function process get magic on C. + +=for apidoc sv_utf8_downgrade_nomg + +Like C, but does not process get magic on C. + +=for apidoc sv_utf8_downgrade_flags + +Like C, but with additional C. +If C has C bit set, then this function process +get magic on C. + =cut */ bool -Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok) +Perl_sv_utf8_downgrade_flags(pTHX_ SV *const sv, const bool fail_ok, const U32 flags) { - PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE; + PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE_FLAGS; if (SvPOKp(sv) && SvUTF8(sv)) { if (SvCUR(sv)) { U8 *s; STRLEN len; - int mg_flags = SV_GMAGIC; + U32 mg_flags = flags & SV_GMAGIC; if (SvIsCOW(sv)) { S_sv_uncow(aTHX_ sv, 0); @@ -3671,7 +3683,7 @@ Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok) MAGIC * mg = mg_find(sv, PERL_MAGIC_regex_global); if (mg && mg->mg_len > 0 && mg->mg_flags & MGf_BYTES) { mg->mg_len = sv_pos_b2u_flags(sv, mg->mg_len, - SV_GMAGIC|SV_CONST_RETURN); + mg_flags|SV_CONST_RETURN); mg_flags = 0; /* sv_pos_b2u does get magic */ } if ((mg = mg_find(sv, PERL_MAGIC_utf8))) diff --git a/sv.h b/sv.h index 24c728dcd2f3..53aea18aeb42 100644 --- a/sv.h +++ b/sv.h @@ -1941,6 +1941,8 @@ Like C but doesn't process magic. #define sv_pvn_force_nomg(sv, lp) sv_pvn_force_flags(sv, lp, 0) #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_utf8_downgrade(sv, fail_ok) sv_utf8_downgrade_flags(sv, fail_ok, SV_GMAGIC) +#define sv_utf8_downgrade_nomg(sv, fail_ok) sv_utf8_downgrade_flags(sv, fail_ok, 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) \