diff options
| -rw-r--r-- | XSUB.h | 19 | ||||
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | util.c | 25 |
5 files changed, 37 insertions, 18 deletions
@@ -304,24 +304,7 @@ Rethrows a previously caught exception. See L<perlguts/"Exception Handling">. #endif #define XS_APIVERSION_BOOTCHECK \ - STMT_START { \ - SV *_xpt = NULL; \ - SV *_compver = Perl_newSVpv(aTHX_ "v" PERL_API_VERSION_STRING, 0); \ - SV *_runver = new_version(PL_apiversion); \ - _compver = upg_version(_compver, 0); \ - if (vcmp(_compver, _runver)) { \ - _xpt = Perl_newSVpvf(aTHX_ "Perl API version %"SVf \ - " of %s does not match %"SVf, \ - SVfARG(Perl_sv_2mortal(aTHX_ vstringify(_compver))), \ - SvPV_nolen_const(ST(0)), \ - SVfARG(Perl_sv_2mortal(aTHX_ vstringify(_runver)))); \ - Perl_sv_2mortal(aTHX_ _xpt); \ - } \ - SvREFCNT_dec(_compver); \ - SvREFCNT_dec(_runver); \ - if (_xpt) \ - Perl_croak_sv(aTHX_ _xpt); \ - } STMT_END + Perl_xs_apiversion_bootcheck(aTHX_ ST(0), STR_WITH_LEN("v" PERL_API_VERSION_STRING)) #ifdef NO_XSLOCKS # define dXCPT dJMPENV; int rEtV = 0 @@ -2259,6 +2259,10 @@ Apo |void* |my_cxt_init |NN int *index|size_t size : XS_VERSION_BOOTCHECK Xpo |void |xs_version_bootcheck|U32 items|U32 ax|NN const char *xs_p \ |STRLEN xs_len +: This function is an implementation detail. The public API for this is +: XS_APIVERSION_BOOTCHECK +Xpo |void |xs_apiversion_bootcheck|NN SV *module|NN const char *api_p \ + |STRLEN api_len #ifndef HAS_STRLCAT Apno |Size_t |my_strlcat |NULLOK char *dst|NULLOK const char *src|Size_t size diff --git a/global.sym b/global.sym index a429d93529..203affb52c 100644 --- a/global.sym +++ b/global.sym @@ -742,6 +742,7 @@ Perl_warn Perl_warn_sv Perl_warner Perl_whichsig +Perl_xs_apiversion_bootcheck Perl_xs_version_bootcheck Perl_yylex Perl_utf8n_to_uvchr @@ -4687,6 +4687,12 @@ PERL_CALLCONV void Perl_write_to_stderr(pTHX_ SV* msv) #define PERL_ARGS_ASSERT_WRITE_TO_STDERR \ assert(msv) +PERL_CALLCONV void Perl_xs_apiversion_bootcheck(pTHX_ SV *module, const char *api_p, STRLEN api_len) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_XS_APIVERSION_BOOTCHECK \ + assert(module); assert(api_p) + PERL_CALLCONV void Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p, STRLEN xs_len) __attribute__nonnull__(pTHX_3); #define PERL_ARGS_ASSERT_XS_VERSION_BOOTCHECK \ @@ -6514,6 +6514,31 @@ Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p, } } +void +Perl_xs_apiversion_bootcheck(pTHX_ SV *module, const char *api_p, + STRLEN api_len) +{ + SV *xpt = NULL; + SV *compver = Perl_newSVpvn(aTHX_ api_p, api_len); + SV *runver = new_version(PL_apiversion); + + PERL_ARGS_ASSERT_XS_APIVERSION_BOOTCHECK; + + compver = upg_version(compver, 0); + if (vcmp(compver, runver)) { + xpt = Perl_newSVpvf(aTHX_ "Perl API version %"SVf + " of %s does not match %"SVf, + SVfARG(Perl_sv_2mortal(aTHX_ vstringify(compver))), + SvPV_nolen_const(module), + SVfARG(Perl_sv_2mortal(aTHX_ vstringify(runver)))); + Perl_sv_2mortal(aTHX_ xpt); + } + SvREFCNT_dec(compver); + SvREFCNT_dec(runver); + if (xpt) + Perl_croak_sv(aTHX_ xpt); +} + #ifndef HAS_STRLCAT Size_t Perl_my_strlcat(char *dst, const char *src, Size_t size) |