diff options
| author | Florian Ragwitz <rafl@debian.org> | 2010-07-22 06:27:04 +0200 |
|---|---|---|
| committer | Steffen Mueller <smueller@cpan.org> | 2010-07-22 12:02:24 +0200 |
| commit | ddb5125fc979ebb146d87e7eedd2e196706c06ea (patch) | |
| tree | e61fe449b6f8ca7065fd678cfc8775c810cb32de /XSUB.h | |
| parent | 114d6fd391232a6b97cfbef2db0e4f17302ee557 (diff) | |
| download | perl-ddb5125fc979ebb146d87e7eedd2e196706c06ea.tar.gz | |
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.
Diffstat (limited to 'XSUB.h')
| -rw-r--r-- | XSUB.h | 34 |
1 files changed, 23 insertions, 11 deletions
@@ -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 |