simplify Perl_xs_apiversion_bootcheck
authorDaniel Dragan <bulk88@hotmail.com>
Fri, 7 Nov 2014 04:57:14 +0000 (23:57 -0500)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 7 Nov 2014 05:50:43 +0000 (21:50 -0800)
We control both strings. Perl API versions are not old decimal or alphas
versions. Maints dont increase Perl API ver. Just do a memcmp. Faster and
less machine code. Before 0xA6 bytes of machine code on VC 2003 32b,
after 0x35. This patch is related to [perl #123136].

XSUB.h
embed.fnc
pod/perlclib.pod
pod/perldiag.pod
proto.h
util.c

diff --git a/XSUB.h b/XSUB.h
index d0fb253..004a0d6 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -331,7 +331,7 @@ Rethrows a previously caught exception.  See L<perlguts/"Exception Handling">.
 #endif
 
 #define XS_APIVERSION_BOOTCHECK                                                \
-    Perl_xs_apiversion_bootcheck(aTHX_ ST(0), STR_WITH_LEN("v" PERL_API_VERSION_STRING))
+    Perl_xs_apiversion_bootcheck(ST(0), STR_WITH_LEN("v" PERL_API_VERSION_STRING))
 
 #ifdef NO_XSLOCKS
 #  define dXCPT             dJMPENV; int rEtV = 0
index 78ad3d8..3b43acd 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2697,7 +2697,7 @@ 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 \
+Xpon   |void   |xs_apiversion_bootcheck|NN SV *module|NN const char *api_p \
                                |STRLEN api_len
 
 #ifndef HAS_STRLCAT
index 7f86f1b..03dce25 100644 (file)
@@ -119,6 +119,9 @@ There is no equivalent to C<fgets>; one should use C<sv_gets> instead:
                                               / strGT(s1,s2)
  strncmp(s1, s2, n)             strnNE(s1, s2, n) / strnEQ(s1, s2, n)
 
+ memcmp(p1, p2, n)              memNE(p1, p2, n)
+ !memcmp(p1, p2, n)             memEQ(p1, p2, n)
+
 Notice the different order of arguments to C<Copy> and C<Move> than used
 in C<memcpy> and C<memmove>.
 
index 262d04b..df15a17 100644 (file)
@@ -4349,6 +4349,11 @@ is equivalent to v5.100.
 recent than the currently running version.  How long has it been since
 you upgraded, anyway?  See L<perlfunc/require>.
 
+=item Perl API version %s of %s does not match %s
+
+(F) The XS module in question was complied against a different incompatible
+version of Perl than the one that has loaded the XS module.
+
 =item PERL_SH_DIR too long
 
 (F) An error peculiar to OS/2.  PERL_SH_DIR is the directory to find the
diff --git a/proto.h b/proto.h
index 6741563..95ad1be 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5153,9 +5153,9 @@ 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);
+PERL_CALLCONV void     Perl_xs_apiversion_bootcheck(SV *module, const char *api_p, STRLEN api_len)
+                       __attribute__nonnull__(1)
+                       __attribute__nonnull__(2);
 #define PERL_ARGS_ASSERT_XS_APIVERSION_BOOTCHECK       \
        assert(module); assert(api_p)
 
diff --git a/util.c b/util.c
index eadd21d..d12ac88 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5380,34 +5380,16 @@ 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,
+Perl_xs_apiversion_bootcheck(SV *module, const char *api_p,
                             STRLEN api_len)
 {
-    SV *xpt = NULL;
-    SV *compver = Perl_newSVpvn_flags(aTHX_ api_p, api_len, SVs_TEMP);
-    SV *runver;
-
     PERL_ARGS_ASSERT_XS_APIVERSION_BOOTCHECK;
 
-    /* This might croak  */
-    compver = upg_version(compver, 0);
-    /* This should never croak */
-    runver = new_version(PL_apiversion);
-    if (vcmp(compver, runver)) {
-       SV *compver_string = vstringify(compver);
-       SV *runver_string = vstringify(runver);
-       xpt = Perl_newSVpvf(aTHX_ "Perl API version %"SVf
-                           " of %"SVf" does not match %"SVf,
-                           SVfARG(compver_string), SVfARG(module),
-                           SVfARG(runver_string));
-       Perl_sv_2mortal(aTHX_ xpt);
-
-       SvREFCNT_dec(compver_string);
-       SvREFCNT_dec(runver_string);
-    }
-    SvREFCNT_dec(runver);
-    if (xpt)
-       Perl_croak_sv(aTHX_ xpt);
+    if(api_len != sizeof("v" PERL_API_VERSION_STRING)-1
+       || memNE(api_p, "v" PERL_API_VERSION_STRING, sizeof("v" PERL_API_VERSION_STRING)-1)) {
+       Perl_croak_nocontext("Perl API version %s of %"SVf" does not match %s",
+                           api_p, SVfARG(module), "v" PERL_API_VERSION_STRING);
+    }
 }
 
 /*