-
Notifications
You must be signed in to change notification settings - Fork 558
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Missing newSVsv_nomg macro variant #16461
Comments
From @paliHi! In perl XS api is missing function which creates a copy of the It is needed in situation when you want to call other perl function (via Table of available functions: magic steal mortal Function which would create a copy of the scalar without processing get Primitive implementation is there: static SV *newSVsv_nomg(SV *sv) { For above case with call_pv() can be useful function like Primitive implementation: static SV *sv_mortalcopy_nosteal_nomg(SV *sv) { Please consider implementing these two functions into perl.h/perlapi. |
From @paliOn Monday 12 March 2018 10:59:55 pali@cpan.org wrote:
Now I found that in blead is undocumented macro sv_mortalcopy_flags and Also there is still a need for newSVsv_nomg()-like function or macro. |
From @paliOn Thursday 09 August 2018 13:22:18 pali@cpan.org wrote:
Hi! Any comments for making Perl_sv_mortalcopy_flags() function public? |
From @paliIn attachment is implementation of newSVsv_nomg() variant macro which |
From @pali0001-Add-newSVsv_nomg-macro-which-is-like-newSVsv-but-doe.patchFrom 1a69aa8329d53d6edfc31b23f829cf6b7135547b Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Thu, 7 Feb 2019 14:10:35 +0100
Subject: [PATCH] Add newSVsv_nomg() macro which is like newSVsv() but does not
process get magic
Both newSVsv() and newSVsv_nomg() are now implemented via new Perl_newSVsv_flags() function.
---
embed.fnc | 4 +++-
embed.h | 2 +-
mathoms.c | 6 ++++++
proto.h | 8 ++++++++
sv.c | 9 +++++++--
sv.h | 3 +++
6 files changed, 28 insertions(+), 4 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index ffdc04e5e8..aed1f0f23f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1210,7 +1210,9 @@ ApdR |SV* |newSVpv_share |NULLOK const char* s|U32 hash
AfpdR |SV* |newSVpvf |NN const char *const pat|...
ApR |SV* |vnewSVpvf |NN const char *const pat|NULLOK va_list *const args
Apd |SV* |newSVrv |NN SV *const rv|NULLOK const char *const classname
-ApdR |SV* |newSVsv |NULLOK SV *const old
+ApmbdR |SV* |newSVsv |NULLOK SV *const old
+ApmdR |SV* |newSVsv_nomg |NULLOK SV *const old
+ApR |SV* |newSVsv_flags |NULLOK SV *const old|I32 flags
ApdR |SV* |newSV_type |const svtype type
ApdR |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first
ApdR |OP* |newUNOP_AUX |I32 type|I32 flags|NULLOK OP* first \
diff --git a/embed.h b/embed.h
index d35508ac44..c863c2ec15 100644
--- a/embed.h
+++ b/embed.h
@@ -546,7 +546,7 @@
#define newSVpvn_flags(a,b,c) Perl_newSVpvn_flags(aTHX_ a,b,c)
#define newSVpvn_share(a,b,c) Perl_newSVpvn_share(aTHX_ a,b,c)
#define newSVrv(a,b) Perl_newSVrv(aTHX_ a,b)
-#define newSVsv(a) Perl_newSVsv(aTHX_ a)
+#define newSVsv_flags(a,b) Perl_newSVsv_flags(aTHX_ a,b)
#define newSVuv(a) Perl_newSVuv(aTHX_ a)
#define newUNOP(a,b,c) Perl_newUNOP(aTHX_ a,b,c)
#define newUNOP_AUX(a,b,c,d) Perl_newUNOP_AUX(aTHX_ a,b,c,d)
diff --git a/mathoms.c b/mathoms.c
index 8b003d3538..b8dcb8913d 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -1755,6 +1755,12 @@ Perl_instr(const char *big, const char *little)
return instr((char *) big, (char *) little);
}
+SV *
+Perl_newSVsv(pTHX_ SV *const old)
+{
+ return newSVsv(old);
+}
+
#endif /* NO_MATHOMS */
/*
diff --git a/proto.h b/proto.h
index 2023f5c75d..8720564f14 100644
--- a/proto.h
+++ b/proto.h
@@ -2516,8 +2516,16 @@ PERL_CALLCONV SV* Perl_newSVpvn_share(pTHX_ const char* s, I32 len, U32 hash)
PERL_CALLCONV SV* Perl_newSVrv(pTHX_ SV *const rv, const char *const classname);
#define PERL_ARGS_ASSERT_NEWSVRV \
assert(rv)
+#ifndef NO_MATHOMS
PERL_CALLCONV SV* Perl_newSVsv(pTHX_ SV *const old)
__attribute__warn_unused_result__;
+#endif
+
+PERL_CALLCONV SV* Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
+ __attribute__warn_unused_result__;
+
+/* PERL_CALLCONV SV* Perl_newSVsv_nomg(pTHX_ SV *const old)
+ __attribute__warn_unused_result__; */
PERL_CALLCONV SV* Perl_newSVuv(pTHX_ const UV u)
__attribute__warn_unused_result__;
diff --git a/sv.c b/sv.c
index ad238cdb3b..fe7e0a64fe 100644
--- a/sv.c
+++ b/sv.c
@@ -9748,11 +9748,15 @@ Perl_newRV(pTHX_ SV *const sv)
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 *
-Perl_newSVsv(pTHX_ SV *const old)
+Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
{
SV *sv;
@@ -9763,7 +9767,8 @@ Perl_newSVsv(pTHX_ SV *const old)
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);
/* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
with SvTEMP_off and SvTEMP_on round a call to sv_setsv. */
diff --git a/sv.h b/sv.h
index f3392b08ec..3136fef243 100644
--- a/sv.h
+++ b/sv.h
@@ -2175,6 +2175,9 @@ struct clone_params {
AV *unreferenced;
};
+#define newSVsv(sv) newSVsv_flags((sv), SV_GMAGIC)
+#define newSVsv_nomg(sv) newSVsv_flags((sv), 0)
+
/*
=for apidoc Am|SV*|newSVpvn_utf8|const char* s|STRLEN len|U32 utf8
--
2.11.0
|
From @paliAnd here is patch which makes sv_mortalcopy_flags() function public. |
From @pali0001-Make-sv_mortalcopy_flags-public.patchFrom 71918e3013329a0120b37905e8046f06ab003eb0 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Thu, 7 Feb 2019 14:22:55 +0100
Subject: [PATCH] Make sv_mortalcopy_flags() public
---
embed.fnc | 2 +-
embed.h | 2 +-
sv.c | 5 +++++
3 files changed, 7 insertions(+), 2 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index aed1f0f23f..9fadb1c7d7 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1634,7 +1634,7 @@ Ein |bool |sv_only_taint_gmagic|NN SV *sv
: exported for re.pm
EXp |MAGIC *|sv_magicext_mglob|NN SV *sv
ApdbmR |SV* |sv_mortalcopy |NULLOK SV *const oldsv
-XpR |SV* |sv_mortalcopy_flags|NULLOK SV *const oldsv|U32 flags
+ApdR |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
diff --git a/embed.h b/embed.h
index c863c2ec15..e3eaca3d1a 100644
--- a/embed.h
+++ b/embed.h
@@ -773,6 +773,7 @@
#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_flags(a,b) Perl_sv_mortalcopy_flags(aTHX_ a,b)
#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)
@@ -1581,7 +1582,6 @@
#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_resetpvn(a,b,c) Perl_sv_resetpvn(aTHX_ a,b,c)
#define sv_sethek(a,b) Perl_sv_sethek(aTHX_ a,b)
#ifndef PERL_IMPLICIT_CONTEXT
diff --git a/sv.c b/sv.c
index fe7e0a64fe..43b906585c 100644
--- a/sv.c
+++ b/sv.c
@@ -9221,6 +9221,11 @@ The new SV is marked as mortal. It will be destroyed "soon", either by an
explicit call to C<FREETMPS>, or by an implicit call at places such as
statement boundaries. See also C<L</sv_newmortal>> and C<L</sv_2mortal>>.
+=for apidoc sv_mortalcopy_flags
+
+Like C<sv_mortalcopy>, but the extra C<flags> are passed to the
+C<sv_setsv_flags>.
+
=cut
*/
--
2.11.0
|
From @tonycozOn Thu, 07 Feb 2019 05:22:52 -0800, pali@cpan.org wrote:
Why not make SV_NOSTEAL significant for newSVsv_flags() ? Otherwise it will be messy adding it in the future. Tony |
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Thu, 07 Feb 2019 05:29:14 -0800, pali@cpan.org wrote:
+=for apidoc sv_mortalcopy_flags SV_GMAGIC is also meaningful for sv_mortalcopy_flags(). Tony |
From @paliOn Tuesday 12 February 2019 20:13:42 Tony Cook via RT wrote:
So... any suggestion how to improve documentation? |
From @paliOn Tuesday 12 February 2019 20:08:47 Tony Cook via RT wrote:
Ok. In attachment is updated V2 patch which supports all flags like |
From @paliv2-0001-Add-newSVsv_nomg-macro-which-is-like-newSVsv-but-doe.patchFrom f8bca093b3ceb8a7e22fbbc7b2b50a30e894c592 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Thu, 7 Feb 2019 14:10:35 +0100
Subject: [PATCH v2] Add newSVsv_nomg() macro which is like newSVsv() but does
not process get magic
Both newSVsv() and newSVsv_nomg() are now implemented via new Perl_newSVsv_flags() function.
---
embed.fnc | 4 +++-
embed.h | 2 +-
mathoms.c | 6 ++++++
proto.h | 8 ++++++++
sv.c | 13 ++++++++-----
sv.h | 5 +++++
6 files changed, 31 insertions(+), 7 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 9d4a8461f5..80d90b985f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1209,7 +1209,9 @@ ApdR |SV* |newSVpv_share |NULLOK const char* s|U32 hash
AfpdR |SV* |newSVpvf |NN const char *const pat|...
ApR |SV* |vnewSVpvf |NN const char *const pat|NULLOK va_list *const args
Apd |SV* |newSVrv |NN SV *const rv|NULLOK const char *const classname
-ApdR |SV* |newSVsv |NULLOK SV *const old
+ApmbdR |SV* |newSVsv |NULLOK SV *const old
+ApmdR |SV* |newSVsv_nomg |NULLOK SV *const old
+ApR |SV* |newSVsv_flags |NULLOK SV *const old|I32 flags
ApdR |SV* |newSV_type |const svtype type
ApdR |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first
ApdR |OP* |newUNOP_AUX |I32 type|I32 flags|NULLOK OP* first \
diff --git a/embed.h b/embed.h
index 4df6fa0b0f..cd58193fb5 100644
--- a/embed.h
+++ b/embed.h
@@ -546,7 +546,7 @@
#define newSVpvn_flags(a,b,c) Perl_newSVpvn_flags(aTHX_ a,b,c)
#define newSVpvn_share(a,b,c) Perl_newSVpvn_share(aTHX_ a,b,c)
#define newSVrv(a,b) Perl_newSVrv(aTHX_ a,b)
-#define newSVsv(a) Perl_newSVsv(aTHX_ a)
+#define newSVsv_flags(a,b) Perl_newSVsv_flags(aTHX_ a,b)
#define newSVuv(a) Perl_newSVuv(aTHX_ a)
#define newUNOP(a,b,c) Perl_newUNOP(aTHX_ a,b,c)
#define newUNOP_AUX(a,b,c,d) Perl_newUNOP_AUX(aTHX_ a,b,c,d)
diff --git a/mathoms.c b/mathoms.c
index 8b003d3538..b8dcb8913d 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -1755,6 +1755,12 @@ Perl_instr(const char *big, const char *little)
return instr((char *) big, (char *) little);
}
+SV *
+Perl_newSVsv(pTHX_ SV *const old)
+{
+ return newSVsv(old);
+}
+
#endif /* NO_MATHOMS */
/*
diff --git a/proto.h b/proto.h
index adf1ef5d40..5c5a0c7d66 100644
--- a/proto.h
+++ b/proto.h
@@ -2516,8 +2516,16 @@ PERL_CALLCONV SV* Perl_newSVpvn_share(pTHX_ const char* s, I32 len, U32 hash)
PERL_CALLCONV SV* Perl_newSVrv(pTHX_ SV *const rv, const char *const classname);
#define PERL_ARGS_ASSERT_NEWSVRV \
assert(rv)
+#ifndef NO_MATHOMS
PERL_CALLCONV SV* Perl_newSVsv(pTHX_ SV *const old)
__attribute__warn_unused_result__;
+#endif
+
+PERL_CALLCONV SV* Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
+ __attribute__warn_unused_result__;
+
+/* PERL_CALLCONV SV* Perl_newSVsv_nomg(pTHX_ SV *const old)
+ __attribute__warn_unused_result__; */
PERL_CALLCONV SV* Perl_newSVuv(pTHX_ const UV u)
__attribute__warn_unused_result__;
diff --git a/sv.c b/sv.c
index 0a4a2e531a..5107202d31 100644
--- a/sv.c
+++ b/sv.c
@@ -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>.)
+=for apidoc newSVsv_nomg
+
+Like C<newSVsv> but does not process get magic.
+
=cut
*/
SV *
-Perl_newSVsv(pTHX_ SV *const old)
+Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
{
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. */
- SvGETMAGIC(old);
+ if (flags & SV_GMAGIC)
+ SvGETMAGIC(old);
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;
}
diff --git a/sv.h b/sv.h
index f3392b08ec..3a648e4971 100644
--- a/sv.h
+++ b/sv.h
@@ -2175,6 +2175,11 @@ struct clone_params {
AV *unreferenced;
};
+/* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
+ with SvTEMP_off and SvTEMP_on round a call to sv_setsv. */
+#define newSVsv(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL)
+#define newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL)
+
/*
=for apidoc Am|SV*|newSVpvn_utf8|const char* s|STRLEN len|U32 utf8
--
2.11.0
|
From @tonycozOn Thu, 14 Feb 2019 03:46:17 -0800, pali@cpan.org wrote:
Thanks, applied as 238f2c1. Tony |
@tonycoz - Status changed from 'open' to 'pending release' |
From @paliOn Wednesday 13 February 2019 20:16:03 pali@cpan.org wrote:
Tony, ping. What do you prefer or how do you want to improve this change? |
From @paliOn Tuesday 26 February 2019 10:00:58 pali@cpan.org wrote:
ping |
@tonycoz - Status changed from 'pending release' to 'open' |
From @tonycozOn Thu, 28 Mar 2019 05:58:25 -0700, pali@cpan.org wrote:
Sorry, I thought this was all resolved (and I was sort of wrong.) Since sv_mortalcopy_flags()'s treatment of S_GMAGIC is equivalent to sv_setsv_flags() treatment, I no longer think there's any extra documentation needed. I mis-read the code, sorry for my misunderstanding and the delay in the response. Tony |
@tonycoz - Status changed from 'open' to 'pending release' |
From @paliOn Thursday 28 March 2019 17:01:47 Tony Cook via RT wrote:
Ok, so are there any other changes needed for this patch? |
From @paliOn Tuesday 02 April 2019 11:51:28 pali@cpan.org wrote:
So if not, can you apply that patch? |
From @tonycozOn Tue, 23 Apr 2019 06:27:36 -0700, pali@cpan.org wrote:
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=132964#txn-1614862 It was applied. Tony |
From @tonycozOn Mon, 13 May 2019 17:09:09 -0700, tonyc wrote:
Your reply didn't make it to the ticket. You're right, I missed a patch, I'll apply it post 5.31. Tony |
@tonycoz - Status changed from 'pending release' to 'open' |
From @tonycozOn Tue, 14 May 2019 17:02:17 -0700, tonyc wrote:
Thanks, applied as c6dcb9e. Sorry for the mix-up. Tony |
@tonycoz - Status changed from 'open' to 'pending release' |
Migrated from rt.perl.org#132964 (status was 'pending release')
Searchable as RT132964$
The text was updated successfully, but these errors were encountered: