In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ddb5125fc979ebb146d87e7eedd2e196706c06ea?hp=114d6fd391232a6b97cfbef2db0e4f17302ee557>
- Log ----------------------------------------------------------------- commit ddb5125fc979ebb146d87e7eedd2e196706c06ea Author: Florian Ragwitz <[email protected]> Date: Thu Jul 22 06:27:04 2010 +0200 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. ----------------------------------------------------------------------- Summary of changes: XSUB.h | 34 +++++++++++++++++++++++----------- 1 files changed, 23 insertions(+), 11 deletions(-) diff --git a/XSUB.h b/XSUB.h index ca2c297..f3ba802 100644 --- 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 -- Perl5 Master Repository
