diff options
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 |