scope.c - improved RCPV support, SAVERCPV SAVEFREERCPV

I misnamed some of the RCPV stuff when it was introduced. The macro
which I called SAVERCPVFREE should have been called SAVERCPV,
and there should also have been a SAVEFREERCPV macro.

Note the naming system for these functions is a bit confusing.
SAVEFREERCPV /just/ frees. SAVERCPV saves and restores (eg, its like
local). SAVEFREESV is an exception. :-( and it behaves like SAVERCPV.
See for instance SAVEPV or similar macros.

There also should have been RCPV_REFCNT_dec() and RCPV_REFCNT_inc()
macros.

There was also missing documentation. This patch should fix all of these
issues. Since this functionality has never been released in a production
perl it should be fine to do these renames, nothing out there should use
these macros yet.

I noticed these oversights while fixing Scope::Upper, see also:
https://github.com/Perl/perl5/issues/20861
https://rt.cpan.org/Ticket/Display.html?id=146897

10 files changed, 154 insertions, 54 deletions

diff --git a/cop.h b/cop.h
index 969a17846b..c7f797baca 100644
--- a/cop.h
+++ b/cop.h
@@ -529,15 +529,38 @@ string C<p>, creating the package if necessary.
 =for apidoc Am|RCPV *|RCPVx|char *pv
 Returns the RCPV structure (struct rcpv) for a refcounted
 string pv created with C<rcpv_new()>.
+No checks are performed to ensure that C<pv> was actually allocated
+with C<rcpv_new()>, it is the callers responsibility to ensure that
+this is the case.
 
 =for apidoc Am|RCPV *|RCPV_REFCOUNT|char *pv
 Returns the refcount for a pv created with C<rcpv_new()>. 
+No checks are performed to ensure that C<pv> was actually allocated
+with C<rcpv_new()>, it is the callers responsibility to ensure that
+this is the case.
+
+=for apidoc Am|RCPV *|RCPV_REFCNT_inc|char *pv
+Increments the refcount for a C<char *> pointer which was created
+with a call to C<rcpv_new()>. Same as calling rcpv_copy().
+No checks are performed to ensure that C<pv> was actually allocated
+with C<rcpv_new()>, it is the callers responsibility to ensure that
+this is the case.
+
+=for apidoc Am|RCPV *|RCPV_REFCNT_dec|char *pv
+Decrements the refcount for a C<char *> pointer which was created
+with a call to C<rcpv_new()>. Same as calling rcpv_free().
+No checks are performed to ensure that C<pv> was actually allocated
+with C<rcpv_new()>, it is the callers responsibility to ensure that
+this is the case.
 
 =for apidoc Am|RCPV *|RCPV_LEN|char *pv
 Returns the length of a pv created with C<rcpv_new()>.
 Note that this reflects the length of the string from the callers
 point of view, it does not include the mandatory null which is
 always injected at the end of the string by rcpv_new().
+No checks are performed to ensure that C<pv> was actually allocated
+with C<rcpv_new()>, it is the callers responsibility to ensure that
+this is the case.
 
 =cut
 */
@@ -558,6 +581,8 @@ typedef struct rcpv RCPV;
 #define RCPVx(pv_arg)       ((RCPV *)((pv_arg) - STRUCT_OFFSET(struct rcpv, pv)))
 #define RCPV_REFCOUNT(pv)   (RCPVx(pv)->refcount)
 #define RCPV_LEN(pv)        (RCPVx(pv)->len-1) /* len always includes space for a null */
+#define RCPV_REFCNT_inc(pv) rcpv_copy(pv)
+#define RCPV_REFCNT_dec(pv) rcpv_free(pv)
 
 #ifdef USE_ITHREADS
 
diff --git a/embed.fnc b/embed.fnc
index 6015ae2902..cfad54bdf3 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2778,6 +2778,7 @@ Cp	|void	|save_destructor_x					\
 : Used in SAVEFREOP(), used in op.c, pp_ctl.c
 CMbp	|void	|save_freeop	|NULLOK OP *o
 CMbp	|void	|save_freepv	|NULLOK char *pv
+Cdp	|void	|save_freercpv	|NN char *rcpv
 CMbp	|void	|save_freesv	|NULLOK SV *sv
 Cdp	|void	|save_generic_pvref					\
 				|NN char **str
@@ -2823,7 +2824,7 @@ Cp	|void	|save_pushptrptr|NULLOK void * const ptr1		\
 Aadip	|char * |savepv 	|NULLOK const char *pv
 Aadip	|char * |savepvn	|NULLOK const char *pv			\
 				|Size_t len
-Cdp	|void	|save_rcpv_free |NN char **ppv
+Cdp	|void	|save_rcpv	|NN char **prcpv
 Cp	|void	|save_re_context
 Adhp	|SV *	|save_scalar	|NN GV *gv
 Cdp	|void	|save_set_svflags					\
diff --git a/embed.h b/embed.h
index 9df1b9578d..cc31ad7031 100644
--- a/embed.h
+++ b/embed.h
@@ -553,6 +553,7 @@
 # define save_delete(a,b,c)                     Perl_save_delete(aTHX_ a,b,c)
 # define save_destructor(a,b)                   Perl_save_destructor(aTHX_ a,b)
 # define save_destructor_x(a,b)                 Perl_save_destructor_x(aTHX_ a,b)
+# define save_freercpv(a)                       Perl_save_freercpv(aTHX_ a)
 # define save_generic_pvref(a)                  Perl_save_generic_pvref(aTHX_ a)
 # define save_generic_svref(a)                  Perl_save_generic_svref(aTHX_ a)
 # define save_gp(a,b)                           Perl_save_gp(aTHX_ a,b)
@@ -569,7 +570,7 @@
 # define save_pushi32ptr(a,b,c)                 Perl_save_pushi32ptr(aTHX_ a,b,c)
 # define save_pushptr(a,b)                      Perl_save_pushptr(aTHX_ a,b)
 # define save_pushptrptr(a,b,c)                 Perl_save_pushptrptr(aTHX_ a,b,c)
-# define save_rcpv_free(a)                      Perl_save_rcpv_free(aTHX_ a)
+# define save_rcpv(a)                           Perl_save_rcpv(aTHX_ a)
 # define save_re_context()                      Perl_save_re_context(aTHX)
 # define save_scalar(a)                         Perl_save_scalar(aTHX_ a)
 # define save_set_svflags(a,b,c)                Perl_save_set_svflags(aTHX_ a,b,c)
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index f7dcadfef9..a25438c681 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -1889,6 +1889,32 @@ and back.
 =for apidoc Amh||SAVESPTR|SV * s
 =for apidoc Amh||SAVEPPTR|char * p
 
+=item C<SAVERCPV(char **ppv)>
+
+This macro arranges to restore the value of a C<char *> variable which
+was allocated with a call to C<rcpv_new()> to its previous state when
+the current pseudo block is completed. The pointer stored in C<*ppv> at
+the time of the call will be refcount incremented and stored on the save
+stack. Later when the current I<pseudo-block> is completed the value
+stored in C<*ppv> will be refcount decremented, and the previous value
+restored from the savestack which will also be refcount decremented.
+
+This is the C<RCPV> equivalent of C<SAVEGENERICSV()>.
+
+=for apidoc Amh||SAVERCPV|char *pv
+
+=item C<SAVEGENERICSV(SV **psv)>
+
+This macro arranges to restore the value of a C<SV *> variable to its
+previous state when the current pseudo block is completed. The pointer
+stored in C<*psv> at the time of the call will be refcount incremented
+and stored on the save stack. Later when the current I<pseudo-block> is
+completed the value stored in C<*ppv> will be refcount decremented, and
+the previous value restored from the savestack which will also be refcount
+decremented. This the C equivalent of C<local $sv>.
+
+=for apidoc Amh||SAVEGENERICSV|char **psv
+
 =item C<SAVEFREESV(SV *sv)>
 
 The refcount of C<sv> will be decremented at the end of
@@ -1913,16 +1939,25 @@ live scope has finished executing.
 
 =item C<SAVEFREEOP(OP *op)>
 
-The C<OP *> is op_free()ed at the end of I<pseudo-block>.
+The C<OP *> is C<op_free()>ed at the end of I<pseudo-block>.
 
 =for apidoc Amh||SAVEFREEOP|OP *op
 
 =item C<SAVEFREEPV(p)>
 
-The chunk of memory which is pointed to by C<p> is Safefree()ed at the
-end of I<pseudo-block>.
+The chunk of memory which is pointed to by C<p> is C<Safefree()>ed at the
+end of the current I<pseudo-block>.
+
+=for apidoc Amh||SAVEFREEPV|char *pv
+
+=item C<SAVEFREERCPV(char *pv)>
+
+Ensures that a C<char *> which was created by a call to C<rcpv_new()> is
+C<rcpv_free()>ed at the end of the current I<pseudo-block>.
+
+This is the RCPV equivalent of C<SAVEFREESV()>.
 
-=for apidoc Amh||SAVEFREEPV|void * p
+=for apidoc Amh||SAVEFREERCPV|char *pv
 
 =item C<SAVECLEARSV(SV *sv)>
 
diff --git a/proto.h b/proto.h
index ca7863f125..74e38aab5f 100644
--- a/proto.h
+++ b/proto.h
@@ -3938,6 +3938,11 @@ Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void *p);
 #define PERL_ARGS_ASSERT_SAVE_DESTRUCTOR_X
 
 PERL_CALLCONV void
+Perl_save_freercpv(pTHX_ char *rcpv);
+#define PERL_ARGS_ASSERT_SAVE_FREERCPV          \
+        assert(rcpv)
+
+PERL_CALLCONV void
 Perl_save_generic_pvref(pTHX_ char **str);
 #define PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF     \
         assert(str)
@@ -4017,9 +4022,9 @@ Perl_save_pushptrptr(pTHX_ void * const ptr1, void * const ptr2, const int type)
 #define PERL_ARGS_ASSERT_SAVE_PUSHPTRPTR
 
 PERL_CALLCONV void
-Perl_save_rcpv_free(pTHX_ char **ppv);
-#define PERL_ARGS_ASSERT_SAVE_RCPV_FREE         \
-        assert(ppv)
+Perl_save_rcpv(pTHX_ char **prcpv);
+#define PERL_ARGS_ASSERT_SAVE_RCPV              \
+        assert(prcpv)
 
 PERL_CALLCONV void
 Perl_save_re_context(pTHX);
diff --git a/regen/scope_types.pl b/regen/scope_types.pl
index fd61d164f8..c722d4c893 100644
--- a/regen/scope_types.pl
+++ b/regen/scope_types.pl
@@ -136,6 +136,7 @@ SAVEt_STACK_POS
 SAVEt_READONLY_OFF
 SAVEt_FREEPADNAME
 SAVEt_STRLEN_SMALL
+SAVEt_FREERCPV
 
 /* two args */
 
@@ -164,7 +165,7 @@ SAVEt_SVREF
 SAVEt_VPTR
 SAVEt_ADELETE
 SAVEt_APTR
-SAVEt_RCPV_FREE
+SAVEt_RCPV
 
 /* three args */
 
diff --git a/scope.c b/scope.c
index 31806d305a..c434b1e46a 100644
--- a/scope.c
+++ b/scope.c
@@ -345,9 +345,9 @@ Perl_save_generic_svref(pTHX_ SV **sptr)
 
 
 /*
-=for apidoc save_rcpv_free
+=for apidoc save_rcpv
 
-Implements C<SAVERCPVFREE>.
+Implements C<SAVERCPV>.
 
 Saves and restores a refcounted string, similar to what
 save_generic_svref would do for a SV*. Can be used to restore
@@ -358,12 +358,29 @@ or be prematurely freed.
 =cut
  */
 void
-Perl_save_rcpv_free(pTHX_ char **ppv) {
-    PERL_ARGS_ASSERT_SAVE_RCPV_FREE;
-    save_pushptrptr(ppv, rcpv_copy(*ppv), SAVEt_RCPV_FREE);
+Perl_save_rcpv(pTHX_ char **prcpv) {
+    PERL_ARGS_ASSERT_SAVE_RCPV;
+    save_pushptrptr(prcpv, rcpv_copy(*prcpv), SAVEt_RCPV);
 }
 
 /*
+=for apidoc save_freercpv
+
+Implements C<SAVEFREERCPV>.
+
+Saves and frees a refcounted string. Calls rcpv_free()
+on the argument when the current pseudo block is finished.
+
+=cut
+ */
+void
+Perl_save_freercpv(pTHX_ char *rcpv) {
+    PERL_ARGS_ASSERT_SAVE_FREERCPV;
+    save_pushptr(rcpv, SAVEt_FREERCPV);
+}
+
+
+/*
 =for apidoc_section $callback
 =for apidoc save_generic_pvref
 
@@ -1175,7 +1192,7 @@ Perl_leave_scope(pTHX_ I32 base)
             break;
         }
 
-        case SAVEt_RCPV_FREE:           /* like generic sv, but for struct rcpv */
+        case SAVEt_RCPV:           /* like generic sv, but for struct rcpv */
         {
             a0 = ap[0]; a1 = ap[1];
             char *old = *a0.any_pvp;
@@ -1185,6 +1202,14 @@ Perl_leave_scope(pTHX_ I32 base)
             break;
         }
 
+        case SAVEt_FREERCPV:           /* like SAVEt_FREEPV but for a RCPV */
+        {
+            a0 = ap[0];
+            char *rcpv = a0.any_pv;
+            (void)rcpv_free(rcpv);
+            break;
+        }
+
         case SAVEt_GVSLOT:			/* any slot in GV */
         {
             HV * hv;
diff --git a/scope.h b/scope.h
index 21ad7202ae..50ccc15a4e 100644
--- a/scope.h
+++ b/scope.h
@@ -177,7 +177,8 @@ scope has the given name. C<name> must be a literal string.
 #define SAVECLEARSV(sv)             save_clearsv((SV**)&(sv))
 #define SAVEGENERICSV(s)            save_generic_svref((SV**)&(s))
 #define SAVEGENERICPV(s)            save_generic_pvref((char**)&(s))
-#define SAVERCPVFREE(s)             save_rcpv_free((char**)&(s))
+#define SAVERCPV(s)                 save_rcpv((char**)&(s))
+#define SAVEFREERCPV(s)             save_freercpv(s)
 #define SAVESHAREDPV(s)             save_shared_pvref((char**)&(s))
 #define SAVESETSVFLAGS(sv,mask,val) save_set_svflags(sv,mask,val)
 #define SAVEFREECOPHH(h)            save_pushptr((void *)(h), SAVEt_FREECOPHH)
@@ -231,7 +232,7 @@ scope has the given name. C<name> must be a literal string.
         SAVECOPFILE_x(c);               \
         CopFILE_debug((c),"SAVECOPFILE",0);   \
     } STMT_END
-#  define SAVECOPFILE_FREE_x(c) SAVERCPVFREE((c)->cop_file)
+#  define SAVECOPFILE_FREE_x(c) SAVERCPV((c)->cop_file)
 #  define SAVECOPFILE_FREE(c)           \
     STMT_START {                        \
         SAVECOPFILE_FREE_x(c);          \
diff --git a/scope_types.h b/scope_types.h
index e021954ff0..f100eb5008 100644
--- a/scope_types.h
+++ b/scope_types.h
@@ -43,45 +43,46 @@
 #define SAVEt_READONLY_OFF        22
 #define SAVEt_FREEPADNAME         23
 #define SAVEt_STRLEN_SMALL        24
+#define SAVEt_FREERCPV            25
 
 /* two args */
 
-#define SAVEt_AV                  25
-#define SAVEt_DESTRUCTOR          26
-#define SAVEt_DESTRUCTOR_X        27
-#define SAVEt_GENERIC_PVREF       28
-#define SAVEt_GENERIC_SVREF       29
-#define SAVEt_GP                  30
-#define SAVEt_GVSV                31
-#define SAVEt_HINTS               32
-#define SAVEt_HPTR                33
-#define SAVEt_HV                  34
-#define SAVEt_I32                 35
-#define SAVEt_INT                 36
-#define SAVEt_ITEM                37
-#define SAVEt_IV                  38
-#define SAVEt_LONG                39
-#define SAVEt_PPTR                40
-#define SAVEt_SAVESWITCHSTACK     41
-#define SAVEt_SHARED_PVREF        42
-#define SAVEt_SPTR                43
-#define SAVEt_STRLEN              44
-#define SAVEt_SV                  45
-#define SAVEt_SVREF               46
-#define SAVEt_VPTR                47
-#define SAVEt_ADELETE             48
-#define SAVEt_APTR                49
-#define SAVEt_RCPV_FREE           50
+#define SAVEt_AV                  26
+#define SAVEt_DESTRUCTOR          27
+#define SAVEt_DESTRUCTOR_X        28
+#define SAVEt_GENERIC_PVREF       29
+#define SAVEt_GENERIC_SVREF       30
+#define SAVEt_GP                  31
+#define SAVEt_GVSV                32
+#define SAVEt_HINTS               33
+#define SAVEt_HPTR                34
+#define SAVEt_HV                  35
+#define SAVEt_I32                 36
+#define SAVEt_INT                 37
+#define SAVEt_ITEM                38
+#define SAVEt_IV                  39
+#define SAVEt_LONG                40
+#define SAVEt_PPTR                41
+#define SAVEt_SAVESWITCHSTACK     42
+#define SAVEt_SHARED_PVREF        43
+#define SAVEt_SPTR                44
+#define SAVEt_STRLEN              45
+#define SAVEt_SV                  46
+#define SAVEt_SVREF               47
+#define SAVEt_VPTR                48
+#define SAVEt_ADELETE             49
+#define SAVEt_APTR                50
+#define SAVEt_RCPV                51
 
 /* three args */
 
-#define SAVEt_HELEM               51
-#define SAVEt_PADSV_AND_MORTALIZE 52
-#define SAVEt_SET_SVFLAGS         53
-#define SAVEt_GVSLOT              54
-#define SAVEt_AELEM               55
-#define SAVEt_DELETE              56
-#define SAVEt_HINTS_HH            57
+#define SAVEt_HELEM               52
+#define SAVEt_PADSV_AND_MORTALIZE 53
+#define SAVEt_SET_SVFLAGS         54
+#define SAVEt_GVSLOT              55
+#define SAVEt_AELEM               56
+#define SAVEt_DELETE              57
+#define SAVEt_HINTS_HH            58
 
 static const U8 leave_scope_arg_counts[] = {
     0, /* SAVEt_ALLOC               */
@@ -109,6 +110,7 @@ static const U8 leave_scope_arg_counts[] = {
     1, /* SAVEt_READONLY_OFF        */
     1, /* SAVEt_FREEPADNAME         */
     1, /* SAVEt_STRLEN_SMALL        */
+    1, /* SAVEt_FREERCPV            */
     2, /* SAVEt_AV                  */
     2, /* SAVEt_DESTRUCTOR          */
     2, /* SAVEt_DESTRUCTOR_X        */
@@ -134,7 +136,7 @@ static const U8 leave_scope_arg_counts[] = {
     2, /* SAVEt_VPTR                */
     2, /* SAVEt_ADELETE             */
     2, /* SAVEt_APTR                */
-    2, /* SAVEt_RCPV_FREE           */
+    2, /* SAVEt_RCPV                */
     3, /* SAVEt_HELEM               */
     3, /* SAVEt_PADSV_AND_MORTALIZE */
     3, /* SAVEt_SET_SVFLAGS         */
@@ -144,6 +146,6 @@ static const U8 leave_scope_arg_counts[] = {
     3  /* SAVEt_HINTS_HH            */
 };
 
-#define MAX_SAVEt 57
+#define MAX_SAVEt 58
 
 /* ex: set ro ft=C: */
diff --git a/sv.c b/sv.c
index 5a7e319720..6644a2757f 100644
--- a/sv.c
+++ b/sv.c
@@ -15219,7 +15219,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
              * the target of the **SV could be something from the *other* thread.
              * So how can this possibly work correctly? */
             break;
-        case SAVEt_RCPV_FREE:
+        case SAVEt_RCPV:
             pv = (char *)POPPTR(ss,ix);
             TOPPTR(nss,ix) = rcpv_copy(pv);
             ptr = POPPTR(ss,ix);
@@ -15355,6 +15355,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
             c = (char*)POPPTR(ss,ix);
             TOPPTR(nss,ix) = pv_dup_inc(c);
             break;
+        case SAVEt_FREERCPV:
+            c = (char *)POPPTR(ss,ix);
+            TOPPTR(nss,ix) = rcpv_copy(c);
+            break;
         case SAVEt_STACK_POS:		/* Position on Perl stack */
             i = POPINT(ss,ix);
             TOPINT(nss,ix) = i;