Apd |MAGIC *|sv_magicext |NN SV *const sv|NULLOK SV *const obj|const int how \
|NULLOK const MGVTBL *const vtbl|NULLOK const char *const name \
|const I32 namlen
-ApdaR |SV* |sv_mortalcopy |NULLOK SV *const oldsv
+ApdbamR |SV* |sv_mortalcopy |NULLOK SV *const oldsv
+XpaR |SV* |sv_mortalcopy_flags|NULLOK SV *const oldsv|U32 flags
ApdR |SV* |sv_newmortal
Apd |SV* |sv_newref |NULLOK SV *const sv
Ap |char* |sv_peek |NULLOK SV* sv
#define sv_len_utf8(a) Perl_sv_len_utf8(aTHX_ a)
#define sv_magic(a,b,c,d,e) Perl_sv_magic(aTHX_ a,b,c,d,e)
#define sv_magicext(a,b,c,d,e,f) Perl_sv_magicext(aTHX_ a,b,c,d,e,f)
-#define sv_mortalcopy(a) Perl_sv_mortalcopy(aTHX_ a)
#define sv_newmortal() Perl_sv_newmortal(aTHX)
#define sv_newref(a) Perl_sv_newref(aTHX_ a)
#define sv_nosharing(a) Perl_sv_nosharing(aTHX_ a)
#define sv_del_backref(a,b) Perl_sv_del_backref(aTHX_ a,b)
#define sv_free_arenas() Perl_sv_free_arenas(aTHX)
#define sv_len_utf8_nomg(a) Perl_sv_len_utf8_nomg(aTHX_ a)
+#define sv_mortalcopy_flags(a,b) Perl_sv_mortalcopy_flags(aTHX_ a,b)
#define sv_ref(a,b,c) Perl_sv_ref(aTHX_ a,b,c)
#define sv_resetpvn(a,b,c) Perl_sv_resetpvn(aTHX_ a,b,c)
#define sv_sethek(a,b) Perl_sv_sethek(aTHX_ a,b)
LEAVE;
}
+SV *
+sv_mortalcopy(SV *sv)
+ CODE:
+ RETVAL = SvREFCNT_inc(sv_mortalcopy(sv));
+ OUTPUT:
+ RETVAL
MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 7;
BEGIN { use_ok('XS::APItest') };
is prototype(\&AUTOLOAD), '$', 'sv_setpv(cv,...) sets prototype';
foo(\1); sv_set_deref(\&AUTOLOAD, '$', 2);
is prototype(\&AUTOLOAD), '$', 'sv_setpvn(cv,...) sets prototype';
+
+# Perhaps this does not belong here? But it is at least testing that
+# sv_mortalcopy uses sv_setsv in an unsurprising way.
+ok !SvIsCOW(sv_mortalcopy(__PACKAGE__)),
+ 'sv_mortalcopy does not COW for extensions [perl #79824]';
PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
+PERL_CALLCONV SV *Perl_sv_mortalcopy(pTHX_ SV *const oldstr);
/* ref() is now a macro using Perl_doref;
* this version provided for binary compatibility only.
return _to_utf8_upper_flags(p, ustrp, lenp, FALSE, NULL);
}
+SV *
+Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
+{
+ Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC);
+}
+
END_EXTERN_C
#endif /* NO_MATHOMS */
#define PERL_ARGS_ASSERT_SV_MAGICEXT \
assert(sv)
-PERL_CALLCONV SV* Perl_sv_mortalcopy(pTHX_ SV *const oldsv)
+/* PERL_CALLCONV SV* Perl_sv_mortalcopy(pTHX_ SV *const oldsv)
+ __attribute__malloc__
+ __attribute__warn_unused_result__; */
+
+PERL_CALLCONV SV* Perl_sv_mortalcopy_flags(pTHX_ SV *const oldsv, U32 flags)
__attribute__malloc__
__attribute__warn_unused_result__;
* permanent location. */
SV *
-Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
+Perl_sv_mortalcopy_flags(pTHX_ SV *const oldstr, U32 flags)
{
dVAR;
SV *sv;
new_SV(sv);
- sv_setsv(sv,oldstr);
+ sv_setsv_flags(sv,oldstr,flags);
PUSH_EXTEND_MORTAL__SV_C(sv);
SvTEMP_on(sv);
return sv;
#define sv_insert(bigstr, offset, len, little, littlelen) \
Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \
(littlelen), SV_GMAGIC)
+#define sv_mortalcopy(sv) \
+ Perl_sv_mortalcopy_flags(aTHX_ sv, SV_GMAGIC|SV_DO_COW_SVSETSV)
/* Should be named SvCatPVN_utf8_upgrade? */
#define sv_catpvn_nomg_utf8_upgrade(dsv, sstr, slen, nsv) \