Lots of C optimizations for both speed/correctness

Clean up a lot of the less efficient uses of various Perl
macros and functions, mostly from bulk88@hotmail.com.  Also
deal with the fact that older Perl's were not handling locale
setting in a consistent manner.  This means going back to the
less efficient but always correct method of ALWAYS copying the
old locale and switch to C and then restoring, for all Perl
releases prior to 5.19.0.  Discontinue support for Perl's prior
to v5.6.2.

15 files changed, 232 insertions, 140 deletions

diff --git a/cpan/version/lib/version.pm b/cpan/version/lib/version.pm
index e20fb6e1a5..280c8595f4 100644
--- a/cpan/version/lib/version.pm
+++ b/cpan/version/lib/version.pm
@@ -1,12 +1,12 @@
 #!perl -w
 package version;
 
-use 5.005_04;
+use 5.006002;
 use strict;
 
 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
 
-$VERSION = 0.9906;
+$VERSION = 0.9907;
 $CLASS = 'version';
 
 # avoid using Exporter
diff --git a/cpan/version/lib/version/regex.pm b/cpan/version/lib/version/regex.pm
index 341902e670..1c8f6e1849 100644
--- a/cpan/version/lib/version/regex.pm
+++ b/cpan/version/lib/version/regex.pm
@@ -4,7 +4,7 @@ use strict;
 
 use vars qw($VERSION $CLASS $STRICT $LAX);
 
-$VERSION = 0.9906;
+$VERSION = 0.9907;
 
 #--------------------------------------------------------------------------#
 # Version regexp components
diff --git a/cpan/version/lib/version/vpp.pm b/cpan/version/lib/version/vpp.pm
index 13e5a7eacb..76b9119eb0 100644
--- a/cpan/version/lib/version/vpp.pm
+++ b/cpan/version/lib/version/vpp.pm
@@ -117,13 +117,12 @@ sub currstr {
 
 package version::vpp;
 
-use 5.005_04;
+use 5.006002;
 use strict;
 
-use POSIX qw/locale_h/;
-use locale;
+use Config;
 use vars qw($VERSION $CLASS @ISA $LAX $STRICT);
-$VERSION = 0.9906;
+$VERSION = 0.9907;
 $CLASS = 'version::vpp';
 
 require version::regex;
@@ -479,7 +478,7 @@ sub scan_version {
     if ($errstr) {
 	# 'undef' is a special case and not an error
 	if ( $s ne 'undef') {
-	    use Carp;
+	    require Carp;
 	    Carp::croak($errstr);
 	}
     }
@@ -654,13 +653,17 @@ sub new
 	    return $self;
 	}
 
-	my $currlocale = setlocale(LC_ALL);
+	if ($Config{d_setlocale}) {
+	    use POSIX qw/locale_h/;
+	    use if $Config{d_setlocale}, 'locale';
+	    my $currlocale = setlocale(LC_ALL);
 
-	# if the current locale uses commas for decimal points, we
-	# just replace commas with decimal places, rather than changing
-	# locales
-	if ( localeconv()->{decimal_point} eq ',' ) {
-	    $value =~ tr/,/./;
+	    # if the current locale uses commas for decimal points, we
+	    # just replace commas with decimal places, rather than changing
+	    # locales
+	    if ( localeconv()->{decimal_point} eq ',' ) {
+		$value =~ tr/,/./;
+	    }
 	}
 
 	if ( not defined $value or $value =~ /^undef$/ ) {
diff --git a/cpan/version/t/00impl-pp.t b/cpan/version/t/00impl-pp.t
index c62889fa79..836a75aa5f 100644
--- a/cpan/version/t/00impl-pp.t
+++ b/cpan/version/t/00impl-pp.t
@@ -9,7 +9,7 @@ use Test::More qw/no_plan/;
 BEGIN {
     (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
     require $coretests;
-    use_ok('version::vpp', 0.9906);
+    use_ok('version::vpp', 0.9907);
 }
 
 BaseTests("version::vpp","new","qv");
diff --git a/cpan/version/t/01base.t b/cpan/version/t/01base.t
index 41ba0f69fb..3c7edcf5c7 100644
--- a/cpan/version/t/01base.t
+++ b/cpan/version/t/01base.t
@@ -9,7 +9,7 @@ use Test::More qw/no_plan/;
 BEGIN {
     (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
     require $coretests;
-    use_ok('version', 0.9906);
+    use_ok('version', 0.9907);
 }
 
 BaseTests("version","new","qv");
diff --git a/cpan/version/t/02derived.t b/cpan/version/t/02derived.t
index 9f2f97e043..5bd443758b 100644
--- a/cpan/version/t/02derived.t
+++ b/cpan/version/t/02derived.t
@@ -10,7 +10,7 @@ use File::Temp qw/tempfile/;
 BEGIN {
     (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
     require $coretests;
-    use_ok("version", 0.9906);
+    use_ok("version", 0.9907);
     # If we made it this far, we are ok.
 }
 
diff --git a/cpan/version/t/03require.t b/cpan/version/t/03require.t
index d480c886c8..48ddcd6d8a 100644
--- a/cpan/version/t/03require.t
+++ b/cpan/version/t/03require.t
@@ -14,7 +14,7 @@ BEGIN {
 # Don't want to use, because we need to make sure that the import doesn't
 # fire just yet (some code does this to avoid importing qv() and delare()).
 require_ok("version");
-is $version::VERSION, 0.9906, "Make sure we have the correct class";
+is $version::VERSION, 0.9907, "Make sure we have the correct class";
 ok(!"main"->can("qv"), "We don't have the imported qv()");
 ok(!"main"->can("declare"), "We don't have the imported declare()");
 
diff --git a/cpan/version/t/05sigdie.t b/cpan/version/t/05sigdie.t
index 5fe52108f1..a145450472 100644
--- a/cpan/version/t/05sigdie.t
+++ b/cpan/version/t/05sigdie.t
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 BEGIN {
-    use version 0.9906;
+    use version 0.9907;
 }
 
 pass "Didn't get caught by the wrong DIE handler, which is a good thing";
diff --git a/cpan/version/t/06noop.t b/cpan/version/t/06noop.t
index 8db4c75397..97c7e6546e 100644
--- a/cpan/version/t/06noop.t
+++ b/cpan/version/t/06noop.t
@@ -7,7 +7,7 @@
 use Test::More qw/no_plan/;
 
 BEGIN {
-    use_ok('version', 0.9906);
+    use_ok('version', 0.9907);
 }
 
 my $v1 = version->new('1.2');
diff --git a/cpan/version/t/07locale.t b/cpan/version/t/07locale.t
index 3503b6ff80..de6588c072 100644
--- a/cpan/version/t/07locale.t
+++ b/cpan/version/t/07locale.t
@@ -11,7 +11,7 @@ use Test::More tests => 7;
 use Config;
 
 BEGIN {
-    use_ok('version', 0.9906);
+    use_ok('version', 0.9907);
 }
 
 SKIP: {
diff --git a/cpan/version/t/08_corelist.t b/cpan/version/t/08_corelist.t
index 8cd2e1427b..48c61c3e6c 100644
--- a/cpan/version/t/08_corelist.t
+++ b/cpan/version/t/08_corelist.t
@@ -5,7 +5,7 @@
 #########################
 
 use Test::More tests => 3;
-use_ok("version", 0.9906);
+use_ok("version", 0.9907);
 
 # do strict lax tests in a sub to isolate a package to test importing
 SKIP: {
diff --git a/cpan/version/t/09_list_util.t b/cpan/version/t/09_list_util.t
index 6348f9d406..110c1a035d 100644
--- a/cpan/version/t/09_list_util.t
+++ b/cpan/version/t/09_list_util.t
@@ -4,7 +4,7 @@
 #########################
 
 use strict;
-use_ok("version", 0.9906);
+use_ok("version", 0.9907);
 use Test::More;
 
 BEGIN {
diff --git a/vutil.c b/vutil.c
index 6cbfc72a22..7979c49c15 100644
--- a/vutil.c
+++ b/vutil.c
@@ -2,6 +2,7 @@
    editing it in the perl core. */
 
 #ifndef PERL_CORE
+#  define PERL_NO_GET_CONTEXT
 #  include "EXTERN.h"
 #  include "perl.h"
 #  include "XSUB.h"
@@ -283,8 +284,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     last = PRESCAN_VERSION(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha);
     if (errstr) {
 	/* "undef" is a special case and not an error */
-	if ( ! ( *s == 'u' && strEQ(s,"undef")) ) {
-	    Safefree(start);
+	if ( ! ( *s == 'u' && strEQ(s+1,"ndef")) ) {
 	    Perl_croak(aTHX_ "%s", errstr);
 	}
     }
@@ -396,7 +396,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 	}
     }
     if ( qv ) { /* quoted versions always get at least three terms*/
-	SSize_t len = av_len(av);
+	SSize_t len = AvFILLp(av);
 	/* This for loop appears to trigger a compiler bug on OS X, as it
 	   loops infinitely. Yes, len is negative. No, it makes no sense.
 	   Compiler in question is:
@@ -432,7 +432,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
 
     /* fix RT#19517 - special case 'undef' as string */
-    if ( *s == 'u' && strEQ(s,"undef") ) {
+    if ( *s == 'u' && strEQ(s+1,"ndef") ) {
 	s += 5;
     }
 
@@ -462,7 +462,7 @@ Perl_new_version(pTHX_ SV *ver)
     dVAR;
     SV * const rv = newSV(0);
     PERL_ARGS_ASSERT_NEW_VERSION;
-    if ( ISA_CLASS_OBJ(ver,"version") ) /* can just copy directly */
+    if ( ISA_VERSION_OBJ(ver) ) /* can just copy directly */
     {
 	SSize_t key;
 	AV * const av = newAV();
@@ -483,24 +483,24 @@ Perl_new_version(pTHX_ SV *ver)
 
 	if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) )
 	    (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1));
-
-	if ( hv_exists(MUTABLE_HV(ver), "width", 5 ) )
 	{
-	    const I32 width = SvIV(*hv_fetchs(MUTABLE_HV(ver), "width", FALSE));
-	    (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
+	    SV ** svp = hv_fetchs(MUTABLE_HV(ver), "width", FALSE);
+	    if(svp) {
+		const I32 width = SvIV(*svp);
+		(void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
+	    }
 	}
-
-	if ( hv_exists(MUTABLE_HV(ver), "original", 8 ) )
 	{
-	    SV * pv = *hv_fetchs(MUTABLE_HV(ver), "original", FALSE);
-	    (void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(pv));
+	    SV ** svp = hv_fetchs(MUTABLE_HV(ver), "original", FALSE);
+	    if(svp)
+		(void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(*svp));
 	}
-
 	sav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(ver), "version", FALSE)));
 	/* This will get reblessed later if a derived class*/
 	for ( key = 0; key <= av_len(sav); key++ )
 	{
-	    const I32 rev = SvIV(*av_fetch(sav, key, FALSE));
+	    SV * const sv = *av_fetch(sav, key, FALSE);
+	    const I32 rev = SvIV(sv);
 	    av_push(av, newSViv(rev));
 	}
 
@@ -512,12 +512,11 @@ Perl_new_version(pTHX_ SV *ver)
 	const MAGIC* const mg = SvVSTRING_mg(ver);
 	if ( mg ) { /* already a v-string */
 	    const STRLEN len = mg->mg_len;
-	    char * const version = savepvn( (const char*)mg->mg_ptr, len);
+	    const char * const version = (const char*)mg->mg_ptr;
 	    sv_setpvn(rv,version,len);
 	    /* this is for consistency with the pure Perl class */
 	    if ( isDIGIT(*version) )
 		sv_insert(rv, 0, 0, "v", 1);
-	    Safefree(version);
 	}
 	else {
 #endif
@@ -556,7 +555,7 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 
     PERL_ARGS_ASSERT_UPG_VERSION;
 
-    if ( SvNOK(ver) && !( SvPOK(ver) && sv_len(ver) == 3 ) )
+    if ( SvNOK(ver) && !( SvPOK(ver) && SvCUR(ver) == 3 ) )
     {
 	STRLEN len;
 
@@ -578,11 +577,13 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 	while (buf[len-1] == '0' && len > 0) len--;
 	if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */
 	version = savepvn(buf, len);
+	SAVEFREEPV(version);
 	SvREFCNT_dec(sv);
     }
 #ifdef SvVOK
     else if ( (mg = SvVSTRING_mg(ver)) ) { /* already a v-string */
 	version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
+	SAVEFREEPV(version);
 	qv = TRUE;
     }
 #endif
@@ -593,16 +594,19 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 	char tbuf[64];
 	len = my_snprintf(tbuf, sizeof(tbuf), "%d", VERSION_MAX);
 	version = savepvn(tbuf, len);
+	SAVEFREEPV(version);
 	Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
 		       "Integer overflow in version %d",VERSION_MAX);
     }
     else if ( SvUOK(ver) || SvIOK(ver) ) {
 	version = savesvpv(ver);
+	SAVEFREEPV(version);
     }
     else if ( SvPOK(ver) )/* must be a string or something like a string */
     {
 	STRLEN len;
 	version = savepvn(SvPV(ver,len), SvCUR(ver));
+	SAVEFREEPV(version);
 #ifndef SvVOK
 #  if PERL_VERSION > 5
 	/* This will only be executed for 5.6.0 - 5.8.0 inclusive */
@@ -619,6 +623,7 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 		    int saw_decimal = 0;
 		    sv_setpvf(nsv,"v%vd",ver);
 		    pos = nver = savepv(SvPV_nolen(nsv));
+                    SAVEFREEPV(pos);
 
 		    /* scan the resulting formatted string */
 		    pos++; /* skip the leading 'v' */
@@ -630,7 +635,6 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 
 		    /* is definitely a v-string */
 		    if ( saw_decimal >= 2 ) {
-			Safefree(version);
 			version = nver;
 		    }
 		    break;
@@ -651,7 +655,6 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 	Perl_ck_warner(aTHX_ packWARN(WARN_MISC), 
 		       "Version string '%s' contains invalid data; "
 		       "ignoring: '%s'", version, s);
-    Safefree(version);
     return ver;
 }
 
@@ -689,6 +692,7 @@ Perl_vverify(pTHX_ SV *vs)
 #endif
 {
     SV *sv;
+    SV **svp;
 
     PERL_ARGS_ASSERT_VVERIFY;
 
@@ -697,8 +701,8 @@ Perl_vverify(pTHX_ SV *vs)
 
     /* see if the appropriate elements exist */
     if ( SvTYPE(vs) == SVt_PVHV
-	 && hv_exists(MUTABLE_HV(vs), "version", 7)
-	 && (sv = SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)))
+	 && (svp = hv_fetchs(MUTABLE_HV(vs), "version", FALSE))
+	 && (sv = SvRV(*svp))
 	 && SvTYPE(sv) == SVt_PVAV )
 	return vs;
     else
@@ -745,10 +749,13 @@ Perl_vnumify(pTHX_ SV *vs)
     /* see if various flags exist */
     if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
 	alpha = TRUE;
-    if ( hv_exists(MUTABLE_HV(vs), "width", 5 ) )
-	width = SvIV(*hv_fetchs(MUTABLE_HV(vs), "width", FALSE));
-    else
-	width = 3;
+    {
+	SV ** svp = hv_fetchs(MUTABLE_HV(vs), "width", FALSE);
+	if ( svp )
+	    width = SvIV(*svp);
+	else
+	    width = 3;
+    }
 
 
     /* attempt to retrieve the version array */
@@ -762,11 +769,15 @@ Perl_vnumify(pTHX_ SV *vs)
 	return newSVpvs("0");
     }
 
-    digit = SvIV(*av_fetch(av, 0, 0));
+    {
+	SV * tsv = *av_fetch(av, 0, 0);
+	digit = SvIV(tsv);
+    }
     sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
     for ( i = 1 ; i < len ; i++ )
     {
-	digit = SvIV(*av_fetch(av, i, 0));
+	SV * tsv = *av_fetch(av, i, 0);
+	digit = SvIV(tsv);
 	if ( width < 3 ) {
 	    const int denom = (width == 2 ? 10 : 100);
 	    const div_t term = div((int)PERL_ABS(digit),denom);
@@ -779,7 +790,8 @@ Perl_vnumify(pTHX_ SV *vs)
 
     if ( len > 0 )
     {
-	digit = SvIV(*av_fetch(av, len, 0));
+	SV * tsv = *av_fetch(av, len, 0);
+	digit = SvIV(tsv);
 	if ( alpha && width == 3 ) /* alpha version */
 	    sv_catpvs(sv,"_");
 	Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
@@ -835,17 +847,22 @@ Perl_vnormal(pTHX_ SV *vs)
     {
 	return newSVpvs("");
     }
-    digit = SvIV(*av_fetch(av, 0, 0));
+    {
+	SV * tsv = *av_fetch(av, 0, 0);
+	digit = SvIV(tsv);
+    }
     sv = Perl_newSVpvf(aTHX_ "v%"IVdf, (IV)digit);
     for ( i = 1 ; i < len ; i++ ) {
-	digit = SvIV(*av_fetch(av, i, 0));
+	SV * tsv = *av_fetch(av, i, 0);
+	digit = SvIV(tsv);
 	Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
     }
 
     if ( len > 0 )
     {
 	/* handle last digit specially */
-	digit = SvIV(*av_fetch(av, len, 0));
+	SV * tsv = *av_fetch(av, len, 0);
+	digit = SvIV(tsv);
 	if ( alpha )
 	    Perl_sv_catpvf(aTHX_ sv, "_%"IVdf, (IV)digit);
 	else
@@ -879,6 +896,7 @@ Perl_vstringify2(pTHX_ SV *vs)
 Perl_vstringify(pTHX_ SV *vs)
 #endif
 {
+    SV ** svp;
     PERL_ARGS_ASSERT_VSTRINGIFY;
 
     /* extract the HV from the object */
@@ -886,9 +904,10 @@ Perl_vstringify(pTHX_ SV *vs)
     if ( ! vs )
 	Perl_croak(aTHX_ "Invalid version object");
 
-    if (hv_exists(MUTABLE_HV(vs), "original",  sizeof("original") - 1)) {
+    svp = hv_fetchs(MUTABLE_HV(vs), "original", FALSE);
+    if (svp) {
 	SV *pv;
-	pv = *hv_fetchs(MUTABLE_HV(vs), "original", FALSE);
+	pv = *svp;
 	if ( SvPOK(pv) )
 	    return newSVsv(pv);
 	else
@@ -951,8 +970,11 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
     i = 0;
     while ( i <= m && retval == 0 )
     {
-	left  = SvIV(*av_fetch(lav,i,0));
-	right = SvIV(*av_fetch(rav,i,0));
+	SV * const lsv = *av_fetch(lav,i,0);
+	SV * rsv;
+	left = SvIV(lsv);
+	rsv = *av_fetch(rav,i,0);
+	right = SvIV(rsv);
 	if ( left < right  )
 	    retval = -1;
 	if ( left > right )
@@ -979,7 +1001,8 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
 	{
 	    while ( i <= r && retval == 0 )
 	    {
-		if ( SvIV(*av_fetch(rav,i,0)) != 0 )
+		SV * const rsv = *av_fetch(rav,i,0);
+		if ( SvIV(rsv) != 0 )
 		    retval = -1; /* not a match after all */
 		i++;
 	    }
@@ -988,7 +1011,8 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
 	{
 	    while ( i <= l && retval == 0 )
 	    {
-		if ( SvIV(*av_fetch(lav,i,0)) != 0 )
+		SV * const lsv = *av_fetch(lav,i,0);
+		if ( SvIV(lsv) != 0 )
 		    retval = +1; /* not a match after all */
 		i++;
 	    }
diff --git a/vutil.h b/vutil.h
index f86631d654..aaf2284e89 100644
--- a/vutil.h
+++ b/vutil.h
@@ -83,7 +83,49 @@ Perl_ck_warner(pTHX_ U32 err, const char* pat, ...)
 #define PERL_VERSION_GE(r,v,s) \
 	(PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
 
-#define ISA_CLASS_OBJ(v,c) (sv_isobject(v) && sv_derived_from(v,c))
+#if PERL_VERSION_LT(5,15,4)
+#  define ISA_VERSION_OBJ(v) (sv_isobject(v) && sv_derived_from(v,"version"))
+#else
+#  define ISA_VERSION_OBJ(v) (sv_isobject(v) && sv_derived_from_pvn(v,"version",7,0))
+#endif
+
+
+#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
+
+/* prototype to pass -Wmissing-prototypes */
+STATIC void
+S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);
+
+STATIC void
+S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+{
+    const GV *const gv = CvGV(cv);
+
+    PERL_ARGS_ASSERT_CROAK_XS_USAGE;
+
+    if (gv) {
+        const char *const gvname = GvNAME(gv);
+        const HV *const stash = GvSTASH(gv);
+        const char *const hvname = stash ? HvNAME(stash) : NULL;
+
+        if (hvname)
+            Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
+        else
+            Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
+    } else {
+        /* Pants. I don't think that it should be possible to get here. */
+        Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
+    }
+}
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#define croak_xs_usage(a,b)	S_croak_xs_usage(aTHX_ a,b)
+#else
+#define croak_xs_usage		S_croak_xs_usage
+#endif
+
+#endif
 
 #if PERL_VERSION_GE(5,9,0) && !defined(PERL_CORE)
 
@@ -109,8 +151,10 @@ const char * Perl_prescan_version2(pTHX_ const char *s, bool strict, const char*
 #  define VNORMAL(a)		Perl_vnormal2(aTHX_ a)
 #  define VCMP(a,b)		Perl_vcmp2(aTHX_ a,b)
 #  define PRESCAN_VERSION(a,b,c,d,e,f,g)	Perl_prescan_version2(aTHX_ a,b,c,d,e,f,g)
+#  undef is_LAX_VERSION
 #  define is_LAX_VERSION(a,b) \
 	(a != Perl_prescan_version2(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL))
+#  undef is_STRICT_VERSION
 #  define is_STRICT_VERSION(a,b) \
 	(a != Perl_prescan_version2(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL))
 
@@ -177,3 +221,21 @@ const char * Perl_prescan_version(pTHX_ const char *s, bool strict, const char**
 #  define PERL_ARGS_ASSERT_CK_WARNER      \
 	assert(pat)
 #endif
+
+
+#if PERL_VERSION_LT(5,19,0)
+# undef STORE_NUMERIC_LOCAL_SET_STANDARD
+# undef RESTORE_NUMERIC_LOCAL
+# ifdef USE_LOCALE
+#  define STORE_NUMERIC_LOCAL_SET_STANDARD()\
+	char *loc = savepv(setlocale(LC_NUMERIC, NULL)); \
+	SAVEFREEPV(loc); \
+	setlocale(LC_NUMERIC, "C");
+
+#  define RESTORE_NUMERIC_LOCAL()\
+	setlocale(LC_NUMERIC, loc);
+# else
+#  define STORE_NUMERIC_LOCAL_SET_STANDARD()
+#  define RESTORE_NUMERIC_LOCAL()
+# endif
+#endif
diff --git a/vxs.inc b/vxs.inc
index 2e4f409390..0a02056561 100644
--- a/vxs.inc
+++ b/vxs.inc
@@ -4,49 +4,53 @@
 #ifdef PERL_CORE
 #  define VXS_CLASS "version"
 #  define VXSp(name) XS_##name
+/* VXSXSDP = XSUB Details Proto */
+#  define VXSXSDP(x) x
 #else
 #  define VXS_CLASS "version::vxs"
 #  define VXSp(name) VXS_##name
+/* proto member is unused in version, it is used in CORE by non version xsubs */
+#  define VXSXSDP(x)
 #endif
 #define VXS(name) XS(VXSp(name))
 
 #ifdef VXS_XSUB_DETAILS
 #  ifdef PERL_CORE
-    {"UNIVERSAL::VERSION", VXSp(universal_version), NULL},
+    {"UNIVERSAL::VERSION", VXSp(universal_version), VXSXSDP(NULL)},
 #  endif
-    {VXS_CLASS "::_VERSION", VXSp(universal_version), NULL},
-    {VXS_CLASS "::()", VXSp(version_noop), NULL},
-    {VXS_CLASS "::new", VXSp(version_new), NULL},
-    {VXS_CLASS "::parse", VXSp(version_new), NULL},
-    {VXS_CLASS "::(\"\"", VXSp(version_stringify), NULL},
-    {VXS_CLASS "::stringify", VXSp(version_stringify), NULL},
-    {VXS_CLASS "::(0+", VXSp(version_numify), NULL},
-    {VXS_CLASS "::numify", VXSp(version_numify), NULL},
-    {VXS_CLASS "::normal", VXSp(version_normal), NULL},
-    {VXS_CLASS "::(cmp", VXSp(version_vcmp), NULL},
-    {VXS_CLASS "::(<=>", VXSp(version_vcmp), NULL},
+    {VXS_CLASS "::_VERSION", VXSp(universal_version), VXSXSDP(NULL)},
+    {VXS_CLASS "::()", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::new", VXSp(version_new), VXSXSDP(NULL)},
+    {VXS_CLASS "::parse", VXSp(version_new), VXSXSDP(NULL)},
+    {VXS_CLASS "::(\"\"", VXSp(version_stringify), VXSXSDP(NULL)},
+    {VXS_CLASS "::stringify", VXSp(version_stringify), VXSXSDP(NULL)},
+    {VXS_CLASS "::(0+", VXSp(version_numify), VXSXSDP(NULL)},
+    {VXS_CLASS "::numify", VXSp(version_numify), VXSXSDP(NULL)},
+    {VXS_CLASS "::normal", VXSp(version_normal), VXSXSDP(NULL)},
+    {VXS_CLASS "::(cmp", VXSp(version_vcmp), VXSXSDP(NULL)},
+    {VXS_CLASS "::(<=>", VXSp(version_vcmp), VXSXSDP(NULL)},
 #  ifdef PERL_CORE
-    {VXS_CLASS "::vcmp", XS_version_vcmp, NULL},
+    {VXS_CLASS "::vcmp", XS_version_vcmp, VXSXSDP(NULL)},
 #  else
-    {VXS_CLASS "::VCMP", VXS_version_vcmp, NULL},
+    {VXS_CLASS "::VCMP", VXS_version_vcmp, VXSXSDP(NULL)},
 #  endif
-    {VXS_CLASS "::(bool", VXSp(version_boolean), NULL},
-    {VXS_CLASS "::boolean", VXSp(version_boolean), NULL},
-    {VXS_CLASS "::(+", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(-", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(*", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(/", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(+=", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(-=", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(*=", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(/=", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(abs", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(nomethod", VXSp(version_noop), NULL},
-    {VXS_CLASS "::noop", VXSp(version_noop), NULL},
-    {VXS_CLASS "::is_alpha", VXSp(version_is_alpha), NULL},
-    {VXS_CLASS "::qv", VXSp(version_qv), NULL},
-    {VXS_CLASS "::declare", VXSp(version_qv), NULL},
-    {VXS_CLASS "::is_qv", VXSp(version_is_qv), NULL},
+    {VXS_CLASS "::(bool", VXSp(version_boolean), VXSXSDP(NULL)},
+    {VXS_CLASS "::boolean", VXSp(version_boolean), VXSXSDP(NULL)},
+    {VXS_CLASS "::(+", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(-", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(*", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(/", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(+=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(-=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(*=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(/=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(abs", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(nomethod", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::noop", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::is_alpha", VXSp(version_is_alpha), VXSXSDP(NULL)},
+    {VXS_CLASS "::qv", VXSp(version_qv), VXSXSDP(NULL)},
+    {VXS_CLASS "::declare", VXSp(version_qv), VXSXSDP(NULL)},
+    {VXS_CLASS "::is_qv", VXSp(version_is_qv), VXSXSDP(NULL)},
 #else
 
 #ifndef dVAR
@@ -73,7 +77,6 @@ VXS(universal_version)
     HV *pkg;
     GV **gvp;
     GV *gv;
-    SV *ret;
     SV *sv;
     const char *undef;
     PERL_UNUSED_ARG(cv);
@@ -97,12 +100,12 @@ VXS(universal_version)
 
     if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
         sv = sv_mortalcopy(sv);
-	if ( ! ISA_CLASS_OBJ(sv, "version"))
+	if ( ! ISA_VERSION_OBJ(sv) )
 	    UPG_VERSION(sv, FALSE);
         undef = NULL;
     }
     else {
-        sv = ret = &PL_sv_undef;
+        sv = &PL_sv_undef;
         undef = "(undef)";
     }
 
@@ -135,7 +138,7 @@ VXS(universal_version)
 	    }
 	}
 
-	if ( ! ISA_CLASS_OBJ(req, "version")) {
+	if ( ! ISA_VERSION_OBJ(req) ) {
 	    /* req may very well be R/O, so create a new object */
 	    req = sv_2mortal( NEW_VERSION(req) );
 	}
@@ -155,10 +158,9 @@ VXS(universal_version)
 		SVfARG(sv_2mortal(sv)));
 	}
     }
-    ST(0) = ret;
 
     /* if the package's $VERSION is not undef, it is upgraded to be a version object */
-    if (ISA_CLASS_OBJ(sv, "version")) {
+    if (ISA_VERSION_OBJ(sv)) {
 	ST(0) = sv_2mortal(VSTRINGIFY(sv));
     } else {
 	ST(0) = sv;
@@ -176,6 +178,7 @@ VXS(version_new)
     const char * classname = "";
     STRLEN len;
     U32 flags = 0;
+    SV * svarg0 = NULL;
     PERL_UNUSED_VAR(cv);
 
     SP -= items;
@@ -192,16 +195,19 @@ VXS(version_new)
         sv_setpvs(vs,"undef");
     }
     else if (items == 3 ) {
+        SV * svarg2;
         vs = sv_newmortal();
+        svarg2 = ST(2);
 #if PERL_VERSION == 5
-        sv_setpvf(vs,"v%s",SvPV_nolen_const(ST(2)));
+        sv_setpvf(vs,"v%s",SvPV_nolen_const(svarg2));
 #else
-        Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
+        Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(svarg2));
 #endif
     }
-    if ( sv_isobject(ST(0)) ) {
+    svarg0 = ST(0);
+    if ( sv_isobject(svarg0) ) {
 	/* get the class if called as an object method */
-	const HV * stash = SvSTASH(SvRV(ST(0)));
+	const HV * stash = SvSTASH(SvRV(svarg0));
 	classname = HvNAME_get(stash);
 	len	  = HvNAMELEN_get(stash);
 #ifdef HvNAMEUTF8
@@ -209,8 +215,8 @@ VXS(version_new)
 #endif
     }
     else {
-	classname = SvPV(ST(0), len);
-	flags     = SvUTF8(ST(0));
+	classname = SvPV(svarg0, len);
+	flags     = SvUTF8(svarg0);
     }
 
     rv = NEW_VERSION(vs);
@@ -229,8 +235,9 @@ VXS(version_new)
 
 #define VTYPECHECK(var, val, varname) \
     STMT_START {							\
-	if (ISA_CLASS_OBJ(val, "version")) {				\
-	    (var) = SvRV(val);						\
+	SV * sv_vtc = val;						\
+	if (ISA_VERSION_OBJ(sv_vtc)) {				\
+	    (var) = SvRV(sv_vtc);						\
 	}								\
 	else								\
 	    Perl_croak(aTHX_ varname " is not of type version");	\
@@ -304,10 +311,9 @@ VXS(version_vcmp)
 	       SV * robj = ST(1);
 	       const IV	 swap = (IV)SvIV(ST(2));
 
-	       if ( !ISA_CLASS_OBJ(robj, "version") )
+	       if ( !ISA_VERSION_OBJ(robj) )
 	       {
-		    robj = NEW_VERSION(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
-		    sv_2mortal(robj);
+		    robj = sv_2mortal(NEW_VERSION(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP)));
 	       }
 	       rvs = SvRV(robj);
 
@@ -357,32 +363,40 @@ VXS(version_noop)
     dXSARGS;
     if (items < 1)
 	croak_xs_usage(cv, "lobj, ...");
-    if (ISA_CLASS_OBJ(ST(0), "version"))
+    if (ISA_VERSION_OBJ(ST(0)))
 	Perl_croak(aTHX_ "operation not supported with version object");
     else
 	Perl_croak(aTHX_ "lobj is not of type version");
     XSRETURN_EMPTY;
 }
 
-VXS(version_is_alpha)
+static
+void
+S_version_check_key(pTHX_ CV * cv, const char * key, int keylen)
 {
     dVAR;
     dXSARGS;
     if (items != 1)
 	croak_xs_usage(cv, "lobj");
-    SP -= items;
     {
-	SV *lobj;
-	VTYPECHECK(lobj, ST(0), "lobj");
-	if ( hv_exists(MUTABLE_HV(lobj), "alpha", 5 ) )
-	    XSRETURN_YES;
+	SV *lobj = POPs;
+	SV *ret;
+	VTYPECHECK(lobj, lobj, "lobj");
+	if ( hv_exists(MUTABLE_HV(lobj), key, keylen ) )
+	    ret = &PL_sv_yes;
 	else
-	    XSRETURN_NO;
+	    ret = &PL_sv_no;
+	PUSHs(ret);
 	PUTBACK;
 	return;
     }
 }
 
+VXS(version_is_alpha)
+{
+    S_version_check_key(aTHX_ cv, "alpha", 5);
+}
+
 VXS(version_qv)
 {
     dVAR;
@@ -391,20 +405,22 @@ VXS(version_qv)
     SP -= items;
     {
 	SV * ver = ST(0);
+	SV * sv0 = ver;
 	SV * rv;
         STRLEN len = 0;
         const char * classname = "";
         U32 flags = 0;
         if ( items == 2 ) {
-	    SvGETMAGIC(ST(1));
-	    if (SvOK(ST(1))) {
-		ver = ST(1);
+	    SV * sv1 = ST(1);
+	    SvGETMAGIC(sv1);
+	    if (SvOK(sv1)) {
+		ver = sv1;
 	    }
 	    else {
 		Perl_croak(aTHX_ "Invalid version format (version required)");
 	    }
-            if ( sv_isobject(ST(0)) ) { /* class called as an object method */
-                const HV * stash = SvSTASH(SvRV(ST(0)));
+            if ( sv_isobject(sv0) ) { /* class called as an object method */
+                const HV * stash = SvSTASH(SvRV(sv0));
                 classname = HvNAME_get(stash);
                 len       = HvNAMELEN_get(stash);
 #ifdef HvNAMEUTF8
@@ -412,8 +428,8 @@ VXS(version_qv)
 #endif
             }
             else {
-	       classname = SvPV(ST(0), len);
-                flags     = SvUTF8(ST(0));
+	       classname = SvPV(sv0, len);
+                flags     = SvUTF8(sv0);
             }
 	}
 	if ( !SvVOK(ver) ) { /* not already a v-string */
@@ -437,23 +453,10 @@ VXS(version_qv)
     return;
 }
 
+
 VXS(version_is_qv)
 {
-    dVAR;
-    dXSARGS;
-    if (items != 1)
-	croak_xs_usage(cv, "lobj");
-    SP -= items;
-    {
-	SV *lobj;
-	VTYPECHECK(lobj, ST(0), "lobj");
-	if ( hv_exists(MUTABLE_HV(lobj), "qv", 2 ) )
-	    XSRETURN_YES;
-	else
-	    XSRETURN_NO;
-	PUTBACK;
-	return;
-    }
+    S_version_check_key(aTHX_ cv, "qv", 2);
 }
 
 #endif