xs_version_bootcheck() must use mortals, as {new,upg}_version() can croak.

It's unlikely that XS_VERSION will contain a bogus version string (for long),
but the value passed in (or derived from $XS_VERSION or $VERSION) might well.
For that case, without this change, temporary SVs created within
xs_version_bootcheck() won't be freed (before interpreter exit).

diff --git a/MANIFEST b/MANIFEST
index 314968e..6ce960d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3406,6 +3406,7 @@ ext/XS-APItest/t/xs_special_subs_require.t        for require too
 ext/XS-APItest/t/xs_special_subs.t     Test that XS BEGIN/CHECK/INIT/END work
 ext/XS-APItest/t/xsub_h.t      Tests for XSUB.h
 ext/XS-APItest/typemap
+ext/XS-APItest/XSUB-redefined-macros.xs        XS code needing redefined macros.
 ext/XS-APItest/XSUB-undef-XS_VERSION.xs        XS code needing #undef XS_VERSION
 ext/XS-Typemap/Makefile.PL     XS::Typemap extension
 ext/XS-Typemap/README          XS::Typemap extension

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 3322922..7b3b10c 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -606,6 +606,7 @@ static int my_keyword_plugin(pTHX_
 }
 
 XS(XS_XS__APItest__XSUB_XS_VERSION_undef);
+XS(XS_XS__APItest__XSUB_XS_VERSION_empty);
 
 #include "const-c.inc"
 
@@ -619,6 +620,7 @@ MODULE = XS::APItest                PACKAGE = XS::APItest::XSUB
 
 BOOT:
     newXS("XS::APItest::XSUB::XS_VERSION_undef", XS_XS__APItest__XSUB_XS_VERSION_undef, __FILE__);
+    newXS("XS::APItest::XSUB::XS_VERSION_empty", XS_XS__APItest__XSUB_XS_VERSION_empty, __FILE__);
 
 void
 XS_VERSION_defined(...)

diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL
index 084de96..6a0271a 100644 (file)
--- a/ext/XS-APItest/Makefile.PL
+++ b/ext/XS-APItest/Makefile.PL
@@ -10,7 +10,7 @@ WriteMakefile(
     ABSTRACT_FROM      => 'APItest.pm', # retrieve abstract from module
     AUTHOR             => 'Tim Jenness <t.jenness@jach.hawaii.edu>, Christian Soeller <csoelle@mph.auckland.ac.nz>, Hugo van der Sanden <hv@crypt.compulink.co.uk>, Andrew Main (Zefram) <zefram@fysh.org>',
     'C'                 => ['exception.c', 'core.c', 'notcore.c'],
-    'OBJECT'            => '$(BASEEXT)$(OBJ_EXT) XSUB-undef-XS_VERSION$(OBJ_EXT) $(O_FILES)',
+    'OBJECT'            => '$(BASEEXT)$(OBJ_EXT) XSUB-undef-XS_VERSION$(OBJ_EXT) XSUB-redefined-macros$(OBJ_EXT) $(O_FILES)',
     realclean => {FILES        => 'const-c.inc const-xs.inc'},
     ($Config{gccversion} && $Config{d_attribute_deprecated} ?
       (CCFLAGS => $Config{ccflags} . ' -Wno-deprecated-declarations') : ()),

diff --git a/ext/XS-APItest/XSUB-redefined-macros.xs b/ext/XS-APItest/XSUB-redefined-macros.xs
new file mode 100644 (file)
index 0000000..afbe674
--- /dev/null
+++ b/ext/XS-APItest/XSUB-redefined-macros.xs
@@ -0,0 +1,19 @@
+#include "EXTERN.h"
+#include "perl.h"
+
+/* We have to be in a different .xs so that we can do this:  */
+
+#undef XS_VERSION
+#define XS_VERSION ""
+#include "XSUB.h"
+
+/* This can't be "MODULE = XS::APItest" as then we get duplicate bootstraps.  */
+MODULE = XS::APItest::XSUB1    PACKAGE = XS::APItest::XSUB
+
+PROTOTYPES: DISABLE
+
+void
+XS_VERSION_empty(...)
+    PPCODE:
+        XS_VERSION_BOOTCHECK;
+        XSRETURN_EMPTY;

diff --git a/ext/XS-APItest/t/xsub_h.t b/ext/XS-APItest/t/xsub_h.t
index c25b3a9..8735552 100644 (file)
--- a/ext/XS-APItest/t/xsub_h.t
+++ b/ext/XS-APItest/t/xsub_h.t
@@ -89,4 +89,29 @@ foreach $XS_VERSION (undef, @versions) {
     }
 }
 
+{
+    my $count = 0;
+    {
+       package Counter;
+       our @ISA = 'version';
+       sub new {
+           ++$count;
+           return version::new(@_);
+       }
+
+       sub DESTROY {
+           --$count;
+       }
+    }
+
+    {
+       my $var = Counter->new();
+       is ($count, 1, "1 object exists");
+       is (eval {XS_VERSION_empty('main', $var); 1}, undef);
+       like ($@, qr/Invalid version format \(version required\)/);
+    }
+
+    is ($count, 0, "no objects exist");
+}
+
 done_testing();

diff --git a/util.c b/util.c
index 16fae9a..e09147f 100644 (file)
--- a/util.c
+++ b/util.c
@@ -6486,10 +6486,9 @@ Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
     }
     if (sv) {
        SV *xpt = NULL;
-       SV *xssv = Perl_newSVpvn(aTHX_ xs_p, xs_len);
+       SV *xssv = Perl_newSVpvn_flags(aTHX_ xs_p, xs_len, SVs_TEMP);
        SV *pmsv = sv_derived_from(sv, "version")
-           ? SvREFCNT_inc_simple_NN(sv)
-           : new_version(sv);
+           ? sv : sv_2mortal(new_version(sv));
        xssv = upg_version(xssv, 0);
        if ( vcmp(pmsv,xssv) ) {
            xpt = Perl_newSVpvf(aTHX_ "%s object version %"SVf
@@ -6501,11 +6500,8 @@ Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
                                vn ? vn : "bootstrap parameter",
                                SVfARG(Perl_sv_2mortal(aTHX_ vstringify(pmsv))));
            Perl_sv_2mortal(aTHX_ xpt);
-       }
-       SvREFCNT_dec(xssv);
-       SvREFCNT_dec(pmsv);
-       if (xpt)
            Perl_croak_sv(aTHX_ xpt);
+       }
     }
 }