Missing SvPV* utf8/byte nomg macro variants

[p5pRT]

Migrated from rt.perl.org#132782 (status was 'pending release')

Searchable as RT132782$

[p5pRT]

From @pali

Hi! Currently in perl there are missing SvPVutf8_nomg and SvPVbyte_nomg
macros, equivalent of SvPVutf8 and SvPVbyte, but without processing get
magic. To write XS module correctly without being affected by Perl's The
Unicode Bug, it is easier to use SvPVutf8 resp. SvPVbyte macros instead
of combination of SvPV + SvUTF8 with manual converting Latin1 to utf8.
But if it is needed to distinguish between undef and string in function
implemented in XS, then it SvPVutf8 cannot be used as it throw warning
in case scalar is undef. I think that it is common requirement to
support API undef or string, therefore SvPVutf8_nomg would be really
useful.

Currently for API which accepts undef or string is required something
like this​:

void
function(arg)
  SV *arg
PREINIT​:
  SV *tmp;
  char *str;
  STRLEN len;
INIT​:
  SvGETMAGIC(arg);
CODE​:
  if (SvOK(arg)) {
  str = SvPV_nomg(arg, len);
  if (!SvUTF8(arg) {
  if (SvGMAGICAL(arg))
  tmp = sv_2mortal(newSVpvn(str, len));
  else
  tmp = arg;
  str = SvPVutf8(tmp, len);
  }
  } else {
  str = NULL;
  len = 0;
  }
... now str/len contains either NULL or utf8 representation of arg ...

Which is really non-intuitive and hard to write from scratch for novice
as there is fully missing such (very common) example in any perl
documentation.

With SvPVutf8_nomg it would reduce code just to​:

void
function(arg)
  SV *arg
PREINIT​:
  char *str;
  STRLEN len;
INIT​:
  SvGETMAGIC(arg);
CODE​:
  if (SvOK(arg)) {
  str = SvPVutf8_nomg(arg, len);
  } else {
  str = NULL;
  len = 0;
  }
... now str/len contains either NULL or utf8 representation of arg ...

Maybe some SvPV* macro which would return NULL without warning for
undefined value can be useful too to even more simplify that code.

Also, perlapi documentation should suggest to use SvPVutf8 (reps.
SvPVbyte) function instead of SvPV as without processing SvUTF8() check,
such code is affected by the Perl's Unicode Bug.

Also, to prevent processing get magic more times, it is needed to call
get magic only once in XS function, so ideally with SvGETMAGIC() and
then using only *_nomg functions/macros.

[p5pRT]

From @khwilliamson

Patches welcome :)
--
Karl Williamson

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @pali

On Wednesday 31 January 2018 06​:48​:21 Karl Williamson via RT wrote​:

Patches welcome :)

What about something like this?

#ifndef SvPVutf8_nomg
PERL_STATIC_INLINE char * SvPVutf8_nomg(pTHX_ SV *sv, STRLEN *len)
{
  char *buf = SvPV_nomg(sv, *len);
  if (SvUTF8(sv))
  return buf;
  if (SvGMAGICAL(sv))
  sv = sv_2mortal(newSVpvn(buf, *len));
  /* There is sv_utf8_upgrade_nomg(), but it is broken prior to Perl version 5.13.10 */
  return SvPVutf8(sv, *len);
}
#define SvPVutf8_nomg(sv, len) SvPVutf8_nomg(aTHX_ (sv), &(len))
#endif

#ifndef SvPVbyte_nomg
PERL_STATIC_INLINE char * SvPVbyte_nomg(pTHX_ SV *sv, STRLEN *len)
{
  char *buf = SvPV_nomg(sv, *len);
  if (!SvUTF8(sv))
  return buf;
  if (SvGMAGICAL(sv))
  {
  sv = sv_2mortal(newSVpvn(buf, *len));
  SvUTF8_on(sv);
  }
  return SvPVbyte(sv, *len);
}
#define SvPVbyte_nomg(sv, len) SvPVbyte_nomg(aTHX_ (sv), &(len))
#endif

[p5pRT]

From @pali

In attachment are RFC patches for new functions/macros​:

sv_utf8_downgrade_flags()
sv_utf8_downgrade_nomg()

sv_2pvbyte_flags()
sv_2pvutf8_flags()

SvPVutf8_nomg()
SvPVbyte_nomg()

SvPV_or_null()
SvPV_or_null_nomg()

SvPVutf8_or_null()
SvPVutf8_or_null_nomg()

SvPVbyte_or_null()
SvPVbyte_or_null_nomg()

What about them?

[p5pRT]

From @pali

0001-Implement-sv_utf8_downgrade_nomg.patch

From a2b03965498f57448e06d54a1ef4e26a7302593c Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sat, 10 Feb 2018 13:40:47 +0100
Subject: [RFC PATCH 1/4] Implement sv_utf8_downgrade_nomg

---
 embed.h | 2 +-
 proto.h | 2 +-
 sv.c    | 9 ++++++---
 sv.h    | 2 ++
 4 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/embed.h b/embed.h
index d1fe34ab66..7df5dfdd52 100644
--- a/embed.h
+++ b/embed.h
@@ -703,7 +703,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)
 #define sv_uv(a)		Perl_sv_uv(aTHX_ a)
diff --git a/proto.h b/proto.h
index 485211540b..e6b52c925e 100644
--- a/proto.h
+++ b/proto.h
@@ -3466,7 +3466,7 @@ 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)
-PERL_CALLCONV bool	Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok);
+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	\
 	assert(sv)
 PERL_CALLCONV void	Perl_sv_utf8_encode(pTHX_ SV *const sv);
diff --git a/sv.c b/sv.c
index fa5295d4ba..6937222aae 100644
--- a/sv.c
+++ b/sv.c
@@ -3598,7 +3598,7 @@ use the C<Encode> extension for that.
 */
 
 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;
 
@@ -3606,7 +3606,10 @@ Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok)
         if (SvCUR(sv)) {
 	    U8 *s;
 	    STRLEN len;
-	    int mg_flags = SV_GMAGIC;
+	    int mg_flags = 0;
+
+            if (flags & SV_GMAGIC)
+                mg_flags = SV_GMAGIC;
 
             if (SvIsCOW(sv)) {
                 S_sv_uncow(aTHX_ sv, 0);
@@ -3616,7 +3619,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 1c7224277f..05aa924f76 100644
--- a/sv.h
+++ b/sv.h
@@ -1919,6 +1919,8 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
 #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) \
-- 
2.11.0

[p5pRT]

From @pali

0002-Fix-do_vecget-and-do_vecset-to-process-GET-magic-onl.patch

From 58f6ccda8f161c8ace9aabed4305ba9e3580fe3f Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sat, 10 Feb 2018 13:41:19 +0100
Subject: [RFC PATCH 2/4] Fix do_vecget and do_vecset to process GET magic only
 once

---
 doop.c | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/doop.c b/doop.c
index 7cc227faac..399a573d7a 100644
--- a/doop.c
+++ b/doop.c
@@ -758,7 +758,7 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
 	Perl_croak(aTHX_ "Illegal number of bits in vec");
 
     if (SvUTF8(sv)) {
-	if (Perl_sv_utf8_downgrade(aTHX_ sv, TRUE)) {
+	if (Perl_sv_utf8_downgrade_flags(aTHX_ sv, TRUE, 0)) {
             /* PVX may have changed */
             s = (unsigned char *) SvPV_flags(sv, srclen, svpv_flags);
         }
@@ -934,10 +934,10 @@ Perl_do_vecset(pTHX_ SV *sv)
                                          SV_GMAGIC | SV_UNDEF_RETURNS_NULL);
     if (SvUTF8(targ)) {
 	/* This is handled by the SvPOK_only below...
-	if (!Perl_sv_utf8_downgrade(aTHX_ targ, TRUE))
+	if (!Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0))
 	    SvUTF8_off(targ);
 	 */
-	(void) Perl_sv_utf8_downgrade(aTHX_ targ, TRUE);
+	(void) Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0);
     }
 
     (void)SvPOK_only(targ);
-- 
2.11.0

[p5pRT]

From @pali

0003-Implement-SvPVutf8_nomg-and-SvPVbyte_nomg.patch

From c5cbcce771edadf1fc261e4e0f2de8c2e6482df6 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sat, 10 Feb 2018 13:41:46 +0100
Subject: [RFC PATCH 3/4] Implement SvPVutf8_nomg and SvPVbyte_nomg

---
 embed.h |  4 ++--
 proto.h |  4 ++--
 sv.c    | 20 ++++++++++++--------
 sv.h    | 10 ++++++++++
 4 files changed, 26 insertions(+), 12 deletions(-)

diff --git a/embed.h b/embed.h
index 7df5dfdd52..a6a3be73f1 100644
--- a/embed.h
+++ b/embed.h
@@ -588,8 +588,8 @@
 #define sv_2mortal(a)		Perl_sv_2mortal(aTHX_ a)
 #define sv_2nv_flags(a,b)	Perl_sv_2nv_flags(aTHX_ a,b)
 #define sv_2pv_flags(a,b,c)	Perl_sv_2pv_flags(aTHX_ a,b,c)
-#define sv_2pvbyte(a,b)		Perl_sv_2pvbyte(aTHX_ a,b)
-#define sv_2pvutf8(a,b)		Perl_sv_2pvutf8(aTHX_ a,b)
+#define sv_2pvbyte_flags(a,b,c)		Perl_sv_2pvbyte_flags(aTHX_ a,b,c)
+#define sv_2pvutf8_flags(a,b,c)		Perl_sv_2pvutf8_flags(aTHX_ a,b,c)
 #define sv_2uv_flags(a,b)	Perl_sv_2uv_flags(aTHX_ a,b)
 #define sv_backoff		Perl_sv_backoff
 #define sv_bless(a,b)		Perl_sv_bless(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index e6b52c925e..9f426debf7 100644
--- a/proto.h
+++ b/proto.h
@@ -3011,7 +3011,7 @@ PERL_CALLCONV char*	Perl_sv_2pv_nolen(pTHX_ SV* sv)
 	assert(sv)
 #endif
 
-PERL_CALLCONV char*	Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp);
+PERL_CALLCONV char*	Perl_sv_2pvbyte_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags);
 #define PERL_ARGS_ASSERT_SV_2PVBYTE	\
 	assert(sv)
 #ifndef NO_MATHOMS
@@ -3021,7 +3021,7 @@ PERL_CALLCONV char*	Perl_sv_2pvbyte_nolen(pTHX_ SV* sv)
 	assert(sv)
 #endif
 
-PERL_CALLCONV char*	Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp);
+PERL_CALLCONV char*	Perl_sv_2pvutf8_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags);
 #define PERL_ARGS_ASSERT_SV_2PVUTF8	\
 	assert(sv)
 #ifndef NO_MATHOMS
diff --git a/sv.c b/sv.c
index 6937222aae..6f297e600e 100644
--- a/sv.c
+++ b/sv.c
@@ -3268,18 +3268,19 @@ Usually accessed via the C<SvPVbyte> macro.
 */
 
 char *
-Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp)
+Perl_sv_2pvbyte_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags)
 {
     PERL_ARGS_ASSERT_SV_2PVBYTE;
 
-    SvGETMAGIC(sv);
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+        mg_get(sv);
     if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
      || isGV_with_GP(sv) || SvROK(sv)) {
 	SV *sv2 = sv_newmortal();
 	sv_copypv_nomg(sv2,sv);
 	sv = sv2;
     }
-    sv_utf8_downgrade(sv,0);
+    sv_utf8_downgrade_nomg(sv,0);
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
 
@@ -3295,15 +3296,18 @@ Usually accessed via the C<SvPVutf8> macro.
 */
 
 char *
-Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp)
+Perl_sv_2pvutf8_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags)
 {
     PERL_ARGS_ASSERT_SV_2PVUTF8;
 
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+        mg_get(sv);
     if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
-     || isGV_with_GP(sv) || SvROK(sv))
-	sv = sv_mortalcopy(sv);
-    else
-        SvGETMAGIC(sv);
+     || isGV_with_GP(sv) || SvROK(sv)) {
+        SV *sv2 = sv_newmortal();
+        sv_copypv_nomg(sv2,sv);
+        sv = sv2;
+    }
     sv_utf8_upgrade_nomg(sv);
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
diff --git a/sv.h b/sv.h
index 05aa924f76..bf4ab9bb5c 100644
--- a/sv.h
+++ b/sv.h
@@ -1730,6 +1730,10 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
     (SvPOK_utf8_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
 
+#define SvPVutf8_nomg(sv, lp) \
+    (SvPOK_utf8_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8_flags(sv, &lp, 0))
+
 #define SvPVutf8_force(sv, lp) \
     (SvPOK_utf8_pure_nogthink(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
@@ -1744,6 +1748,10 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
     (SvPOK_byte_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
 
+#define SvPVbyte_nomg(sv, lp) \
+    (SvPOK_byte_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte_flags(sv, &lp, 0))
+
 #define SvPVbyte_force(sv, lp) \
     (SvPOK_byte_pure_nogthink(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp))
@@ -1935,7 +1943,9 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
 #define sv_copypv_nomg(dsv, ssv) sv_copypv_flags(dsv, ssv, 0)
 #define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC)
 #define sv_2pv_nolen(sv) sv_2pv(sv, 0)
+#define sv_2pvbyte(sv, lp) sv_2pvbyte_flags(sv, lp, SV_GMAGIC)
 #define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0)
+#define sv_2pvutf8(sv, lp) sv_2pvutf8_flags(sv, lp, SV_GMAGIC)
 #define sv_2pvutf8_nolen(sv) sv_2pvutf8(sv, 0)
 #define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0)
 #define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC)
-- 
2.11.0

[p5pRT]

From @pali

0004-Implement-SvPV-_or_null.patch

From 8e9bc41cd5a3176442023d67cf90ead64e3f9016 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sat, 10 Feb 2018 15:10:04 +0100
Subject: [RFC PATCH 4/4] Implement SvPV*_or_null*

---
 sv.h | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/sv.h b/sv.h
index bf4ab9bb5c..8199f572d5 100644
--- a/sv.h
+++ b/sv.h
@@ -1670,6 +1670,7 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
 #define SvPV(sv, lp)         SvPV_flags(sv, lp, SV_GMAGIC)
 #define SvPV_const(sv, lp)   SvPV_flags_const(sv, lp, SV_GMAGIC)
 #define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
+#define SvPV_or_null(sv, lp) (SvGETMAGIC(sv), SvPV_or_null_nomg(sv, lp))
 
 #define SvPV_flags(sv, lp, flags) \
     (SvPOK_nog(sv) \
@@ -1723,6 +1724,7 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
 #define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
 #define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
 #define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
+#define SvPV_or_null_nomg(sv, lp) (SvOK(sv) ? SvPV_nomg(sv, lp) : ((lp = 0), NULL))
 
 /* ----*/
 
@@ -1730,10 +1732,20 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
     (SvPOK_utf8_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
 
+#define SvPVutf8_or_null(sv, lp) \
+    (SvPOK_utf8_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : (SvGETMAGIC(sv), SvOK(sv)) \
+     ? sv_2pvutf8_flags(sv, &lp, 0) : ((lp = 0), NULL))
+
 #define SvPVutf8_nomg(sv, lp) \
     (SvPOK_utf8_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8_flags(sv, &lp, 0))
 
+#define SvPVutf8_or_null_nomg(sv, lp) \
+    (SvPOK_utf8_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : SvOK(sv) \
+     ? sv_2pvutf8_flags(sv, &lp, 0) : ((lp = 0), NULL))
+
 #define SvPVutf8_force(sv, lp) \
     (SvPOK_utf8_pure_nogthink(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
@@ -1748,10 +1760,20 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
     (SvPOK_byte_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
 
+#define SvPVbyte_or_null(sv, lp) \
+    (SvPOK_byte_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : (SvGETMAGIC(sv), SvOK(sv)) \
+     ? sv_2pvbyte_flags(sv, &lp, 0) : ((lp = 0), NULL))
+
 #define SvPVbyte_nomg(sv, lp) \
     (SvPOK_byte_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte_flags(sv, &lp, 0))
 
+#define SvPVbyte_or_null_nomg(sv, lp) \
+    (SvPOK_utf8_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : SvOK(sv) \
+     ? sv_2pvbyte_flags(sv, &lp, 0) : ((lp = 0), NULL))
+
 #define SvPVbyte_force(sv, lp) \
     (SvPOK_byte_pure_nogthink(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp))
-- 
2.11.0

[p5pRT]

From @pali

On Sunday 11 February 2018 12​:44​:31 pali@​cpan.org wrote​:

In attachment are RFC patches for new functions/macros​:

sv_utf8_downgrade_flags()
sv_utf8_downgrade_nomg()

sv_2pvbyte_flags()
sv_2pvutf8_flags()

SvPVutf8_nomg()
SvPVbyte_nomg()

SvPV_or_null()
SvPV_or_null_nomg()

SvPVutf8_or_null()
SvPVutf8_or_null_nomg()

SvPVbyte_or_null()
SvPVbyte_or_null_nomg()

What about them?

Hello, can somebody comment / review these patches?

[p5pRT]

From @pali

In attachment are rebased patches on current blead.

[p5pRT]

From @pali

v2-0001-Implement-sv_utf8_downgrade_nomg.patch

From c91c1eab30be09f24654805f4472dd11f7b26787 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sat, 10 Feb 2018 13:40:47 +0100
Subject: [PATCH 1/4] Implement sv_utf8_downgrade_nomg

---
 embed.h | 2 +-
 proto.h | 2 +-
 sv.c    | 9 ++++++---
 sv.h    | 2 ++
 4 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/embed.h b/embed.h
index 8e762bc248..c82799b75b 100644
--- a/embed.h
+++ b/embed.h
@@ -850,7 +850,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/proto.h b/proto.h
index 0e6c76a3bc..5bb7194698 100644
--- a/proto.h
+++ b/proto.h
@@ -3652,7 +3652,7 @@ 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)
-PERL_CALLCONV bool	Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok);
+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	\
 	assert(sv)
 PERL_CALLCONV void	Perl_sv_utf8_encode(pTHX_ SV *const sv);
diff --git a/sv.c b/sv.c
index 77f63183f7..abb1ed4a10 100644
--- a/sv.c
+++ b/sv.c
@@ -3600,7 +3600,7 @@ use the C<Encode> extension for that.
 */
 
 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;
 
@@ -3608,7 +3608,10 @@ Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok)
         if (SvCUR(sv)) {
 	    U8 *s;
 	    STRLEN len;
-	    int mg_flags = SV_GMAGIC;
+	    int mg_flags = 0;
+
+            if (flags & SV_GMAGIC)
+                mg_flags = SV_GMAGIC;
 
             if (SvIsCOW(sv)) {
                 S_sv_uncow(aTHX_ sv, 0);
@@ -3618,7 +3621,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 f3392b08ec..4bf948f6d7 100644
--- a/sv.h
+++ b/sv.h
@@ -1915,6 +1915,8 @@ Like C<sv_catsv> 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) \
-- 
2.11.0

[p5pRT]

From @pali

v2-0002-Fix-do_vecget-and-do_vecset-to-process-GET-magic-onl.patch

From c7ee9830d6a45c7ecaa8a38d97f9da287d7ad2f1 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sat, 10 Feb 2018 13:41:19 +0100
Subject: [PATCH 2/4] Fix do_vecget and do_vecset to process GET magic only
 once

---
 doop.c | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/doop.c b/doop.c
index 54e35f10a6..febff6e217 100644
--- a/doop.c
+++ b/doop.c
@@ -758,7 +758,7 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
 	Perl_croak(aTHX_ "Illegal number of bits in vec");
 
     if (SvUTF8(sv)) {
-	if (Perl_sv_utf8_downgrade(aTHX_ sv, TRUE)) {
+	if (Perl_sv_utf8_downgrade_flags(aTHX_ sv, TRUE, 0)) {
             /* PVX may have changed */
             s = (unsigned char *) SvPV_flags(sv, srclen, svpv_flags);
         }
@@ -934,10 +934,10 @@ Perl_do_vecset(pTHX_ SV *sv)
                                          SV_GMAGIC | SV_UNDEF_RETURNS_NULL);
     if (SvUTF8(targ)) {
 	/* This is handled by the SvPOK_only below...
-	if (!Perl_sv_utf8_downgrade(aTHX_ targ, TRUE))
+	if (!Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0))
 	    SvUTF8_off(targ);
 	 */
-	(void) Perl_sv_utf8_downgrade(aTHX_ targ, TRUE);
+	(void) Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0);
     }
 
     (void)SvPOK_only(targ);
-- 
2.11.0

[p5pRT]

From @pali

v2-0003-Implement-SvPVutf8_nomg-and-SvPVbyte_nomg.patch

From 6a70a3ac23f50777aae98f0b0c938fcfa45f33a8 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sat, 10 Feb 2018 13:41:46 +0100
Subject: [PATCH 3/4] Implement SvPVutf8_nomg and SvPVbyte_nomg

---
 embed.h |  4 ++--
 proto.h |  4 ++--
 sv.c    | 20 ++++++++++++--------
 sv.h    | 10 ++++++++++
 4 files changed, 26 insertions(+), 12 deletions(-)

diff --git a/embed.h b/embed.h
index c82799b75b..1fb183561e 100644
--- a/embed.h
+++ b/embed.h
@@ -723,8 +723,8 @@
 #define sv_2mortal(a)		Perl_sv_2mortal(aTHX_ a)
 #define sv_2nv_flags(a,b)	Perl_sv_2nv_flags(aTHX_ a,b)
 #define sv_2pv_flags(a,b,c)	Perl_sv_2pv_flags(aTHX_ a,b,c)
-#define sv_2pvbyte(a,b)		Perl_sv_2pvbyte(aTHX_ a,b)
-#define sv_2pvutf8(a,b)		Perl_sv_2pvutf8(aTHX_ a,b)
+#define sv_2pvbyte_flags(a,b,c)		Perl_sv_2pvbyte_flags(aTHX_ a,b,c)
+#define sv_2pvutf8_flags(a,b,c)		Perl_sv_2pvutf8_flags(aTHX_ a,b,c)
 #define sv_2uv_flags(a,b)	Perl_sv_2uv_flags(aTHX_ a,b)
 #define sv_backoff		Perl_sv_backoff
 #define sv_bless(a,b)		Perl_sv_bless(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index 5bb7194698..eeb496ba5f 100644
--- a/proto.h
+++ b/proto.h
@@ -3183,7 +3183,7 @@ PERL_CALLCONV char*	Perl_sv_2pv_nolen(pTHX_ SV* sv)
 	assert(sv)
 #endif
 
-PERL_CALLCONV char*	Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp);
+PERL_CALLCONV char*	Perl_sv_2pvbyte_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags);
 #define PERL_ARGS_ASSERT_SV_2PVBYTE	\
 	assert(sv)
 #ifndef NO_MATHOMS
@@ -3193,7 +3193,7 @@ PERL_CALLCONV char*	Perl_sv_2pvbyte_nolen(pTHX_ SV* sv)
 	assert(sv)
 #endif
 
-PERL_CALLCONV char*	Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp);
+PERL_CALLCONV char*	Perl_sv_2pvutf8_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags);
 #define PERL_ARGS_ASSERT_SV_2PVUTF8	\
 	assert(sv)
 #ifndef NO_MATHOMS
diff --git a/sv.c b/sv.c
index abb1ed4a10..c81f23c143 100644
--- a/sv.c
+++ b/sv.c
@@ -3270,18 +3270,19 @@ Usually accessed via the C<SvPVbyte> macro.
 */
 
 char *
-Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp)
+Perl_sv_2pvbyte_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags)
 {
     PERL_ARGS_ASSERT_SV_2PVBYTE;
 
-    SvGETMAGIC(sv);
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+        mg_get(sv);
     if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
      || isGV_with_GP(sv) || SvROK(sv)) {
 	SV *sv2 = sv_newmortal();
 	sv_copypv_nomg(sv2,sv);
 	sv = sv2;
     }
-    sv_utf8_downgrade(sv,0);
+    sv_utf8_downgrade_nomg(sv,0);
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
 
@@ -3297,15 +3298,18 @@ Usually accessed via the C<SvPVutf8> macro.
 */
 
 char *
-Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp)
+Perl_sv_2pvutf8_flags(pTHX_ SV *sv, STRLEN *const lp, const U32 flags)
 {
     PERL_ARGS_ASSERT_SV_2PVUTF8;
 
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+        mg_get(sv);
     if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
-     || isGV_with_GP(sv) || SvROK(sv))
-	sv = sv_mortalcopy(sv);
-    else
-        SvGETMAGIC(sv);
+     || isGV_with_GP(sv) || SvROK(sv)) {
+        SV *sv2 = sv_newmortal();
+        sv_copypv_nomg(sv2,sv);
+        sv = sv2;
+    }
     sv_utf8_upgrade_nomg(sv);
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
diff --git a/sv.h b/sv.h
index 4bf948f6d7..8f60c3f538 100644
--- a/sv.h
+++ b/sv.h
@@ -1726,6 +1726,10 @@ Like C<sv_catsv> but doesn't process magic.
     (SvPOK_utf8_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
 
+#define SvPVutf8_nomg(sv, lp) \
+    (SvPOK_utf8_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8_flags(sv, &lp, 0))
+
 #define SvPVutf8_force(sv, lp) \
     (SvPOK_utf8_pure_nogthink(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
@@ -1740,6 +1744,10 @@ Like C<sv_catsv> but doesn't process magic.
     (SvPOK_byte_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
 
+#define SvPVbyte_nomg(sv, lp) \
+    (SvPOK_byte_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte_flags(sv, &lp, 0))
+
 #define SvPVbyte_force(sv, lp) \
     (SvPOK_byte_pure_nogthink(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp))
@@ -1931,7 +1939,9 @@ Like C<sv_catsv> but doesn't process magic.
 #define sv_copypv_nomg(dsv, ssv) sv_copypv_flags(dsv, ssv, 0)
 #define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC)
 #define sv_2pv_nolen(sv) sv_2pv(sv, 0)
+#define sv_2pvbyte(sv, lp) sv_2pvbyte_flags(sv, lp, SV_GMAGIC)
 #define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0)
+#define sv_2pvutf8(sv, lp) sv_2pvutf8_flags(sv, lp, SV_GMAGIC)
 #define sv_2pvutf8_nolen(sv) sv_2pvutf8(sv, 0)
 #define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0)
 #define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC)
-- 
2.11.0

[p5pRT]

From @pali

v2-0004-Implement-SvPV-_or_null.patch

From 807b85a3d7681382a37c85987c52cdb3a48d55c6 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sat, 10 Feb 2018 15:10:04 +0100
Subject: [PATCH 4/4] Implement SvPV*_or_null*

---
 sv.h | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/sv.h b/sv.h
index 8f60c3f538..c5fd59b217 100644
--- a/sv.h
+++ b/sv.h
@@ -1726,10 +1726,20 @@ Like C<sv_catsv> but doesn't process magic.
     (SvPOK_utf8_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
 
+#define SvPVutf8_or_null(sv, lp) \
+    (SvPOK_utf8_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : (SvGETMAGIC(sv), SvOK(sv)) \
+     ? sv_2pvutf8_flags(sv, &lp, 0) : ((lp = 0), NULL))
+
 #define SvPVutf8_nomg(sv, lp) \
     (SvPOK_utf8_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8_flags(sv, &lp, 0))
 
+#define SvPVutf8_or_null_nomg(sv, lp) \
+    (SvPOK_utf8_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : SvOK(sv) \
+     ? sv_2pvutf8_flags(sv, &lp, 0) : ((lp = 0), NULL))
+
 #define SvPVutf8_force(sv, lp) \
     (SvPOK_utf8_pure_nogthink(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
@@ -1744,10 +1754,20 @@ Like C<sv_catsv> but doesn't process magic.
     (SvPOK_byte_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
 
+#define SvPVbyte_or_null(sv, lp) \
+    (SvPOK_byte_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : (SvGETMAGIC(sv), SvOK(sv)) \
+     ? sv_2pvbyte_flags(sv, &lp, 0) : ((lp = 0), NULL))
+
 #define SvPVbyte_nomg(sv, lp) \
     (SvPOK_byte_nog(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte_flags(sv, &lp, 0))
 
+#define SvPVbyte_or_null_nomg(sv, lp) \
+    (SvPOK_utf8_nog(sv) \
+     ? ((lp = SvCUR(sv)), SvPVX(sv)) : SvOK(sv) \
+     ? sv_2pvbyte_flags(sv, &lp, 0) : ((lp = 0), NULL))
+
 #define SvPVbyte_force(sv, lp) \
     (SvPOK_byte_pure_nogthink(sv) \
      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp))
-- 
2.11.0