Fix leaks in XS_VERSION_BOOTCHECK

The SV holding XS_VERSION, and the version object created from it were
leaked. Also, if the version from perl space wasn't a version object already,
the one that got created leaked.

Additionally, in case of an error, the two SVs returned by vstringify were
leaked.

diff --git a/XSUB.h b/XSUB.h
index ca2c297..f3ba802 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -293,7 +293,7 @@ Rethrows a previously caught exception.  See L<perlguts/"Exception Handling">.
 #define newXSproto(a,b,c,d)    newXS_flags(a,b,c,d,0)
 
 #ifdef XS_VERSION
-#  define XS_VERSION_BOOTCHECK \
+#  define XS_VERSION_BOOTCHECK                                         \
     STMT_START {                                                       \
        SV *_sv;                                                        \
        const char *vn = NULL, *module = SvPV_nolen_const(ST(0));       \
@@ -304,19 +304,31 @@ Rethrows a previously caught exception.  See L<perlguts/"Exception Handling">.
            _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,              \
                                vn = "XS_VERSION"), FALSE);             \
            if (!_sv || !SvOK(_sv))                                     \
-               _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,  \
+               _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,          \
                                    vn = "VERSION"), FALSE);            \
        }                                                               \
        if (_sv) {                                                      \
-           SV *xssv = Perl_newSVpv(aTHX_ XS_VERSION, 0);               \
-           xssv = new_version(xssv);                                   \
-           if ( !sv_derived_from(_sv, "version") )                     \
-               _sv = new_version(_sv);                         \
-           if ( vcmp(_sv,xssv) )                                       \
-               Perl_croak(aTHX_ "%s object version %"SVf" does not match %s%s%s%s %"SVf,\
-                     module, SVfARG(vstringify(xssv)),                 \
-                     vn ? "$" : "", vn ? module : "", vn ? "::" : "",  \
-                     vn ? vn : "bootstrap parameter", SVfARG(vstringify(_sv)));\
+           SV *xpt = NULL;                                             \
+           SV *xssv = Perl_newSVpvn(aTHX_ STR_WITH_LEN(XS_VERSION));   \
+           SV *pmsv = sv_derived_from(_sv, "version")                  \
+               ? SvREFCNT_inc_simple_NN(_sv)                           \
+               : new_version(_sv);                                     \
+           xssv = upg_version(xssv, 0);                                \
+           if ( vcmp(pmsv,xssv) ) {                                    \
+               xpt = Perl_newSVpvf(aTHX_ "%s object version %"SVf      \
+                                   " does not match %s%s%s%s %"SVf,    \
+                                   module,                             \
+                                   SVfARG(Perl_sv_2mortal(aTHX_ vstringify(xssv))), \
+                                   vn ? "$" : "", vn ? module : "",    \
+                                   vn ? "::" : "",                     \
+                                   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);                               \
        }                                                               \
     } STMT_END
 #else