scope.c - add mortal_destructor_sv() and mortal_svfunc_x()

The function SAVEDESTRUCTOR_X() (save_destructor_x) can be used to
execute a C function at the end of the current psuedo-block. Prior to
this patch there was no "mortal" equivalent that would execute at the
end of the current statement. We offer a collection of functions which
are intended to free SV's at either point in time, but only support
callbacks at the end of the current pseudo-block.

This patch adds two such functions, "mortal_destructor_sv" which can be
used to trigger a perl code reference to execute at the end of the
current statement, and "mortal_svfunc_x" which can be used to trigger an
SVFUNC_t C function at the end of the current statement.

Both functions differ from save_destructor_x() in that instead of
supporting a void pointer argument they both require their argument to
be some sort of SV pointer. The Perl callback function triggered by
"mortal_destructor_sv" may be provided no arguments, a single argument
or a list of arguments, depending on the type of argument provided to
mortal_destructor_sv(): when the argument is a raw AV (with no SV ref
wrapping it), then the contents of the AV are passed in as a list of
arguments. When the argument is anything else but NULL, the argument is
provided as a single argument, and when it is NULL the perl function is
called with no arguments.

Both functions are implemented on top of a mortal SV (unseen by the
user) which has PERL_MAGIC_destruct magic associated with it, which
triggers the destructor behavior when the SV is freed.

Both functions are provided with macros to match the normal SAVExx()
API, with MORTALDESTRUCTOR_SV() wrapping mortal_destructor_sv() and
MORTALSVFUNC_X() wrapping mortal_svfunc_x().

The heart of this logic cribbed from Leon Timmermans' Variable-OnDestruct.
See the code at:

https://metacpan.org/dist/Variable-OnDestruct/source/lib/Variable/OnDestruct.xs#L6-17

I am very grateful to him for his help on this. Any errors or omissions
in this code are my fault, not his.

1 files changed, 8 insertions, 0 deletions

diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
index e61dc2cce9..debe6bf066 100644
--- a/regen/mg_vtable.pl
+++ b/regen/mg_vtable.pl
@@ -212,6 +212,12 @@ my %mg =
                    vtable => 'debugvar' },
      lvref => { char => '\\', vtable => 'lvref',
                   desc => "Lvalue reference constructor" },
+     destruct => {
+        char        => "X",
+        vtable      => 'destruct',
+        desc        => "destruct callback",
+        value_magic => 1,
+     },
 );
 
 
@@ -288,6 +294,7 @@ my %vtable_conf =
      'checkcall' => {copy => 'copycallchecker'},
      'debugvar' => { set => 'setdebugvar', get => 'getdebugvar' },
      'lvref' => {set => 'setlvref'},
+     'destruct' => {free => 'freedestruct'},
 );
 
 
@@ -428,6 +435,7 @@ EOH
                     ($desc, @cont) = $desc =~ /(.{1,$desc_wrap})(?: |\z)/g
                 }
             }
+            s/\s+\z// for $desc, @cont;
             printf $format, $type, $vtbl, $desc;
             printf $format, '', '', $_ foreach @cont;
         }