Import version.pm 0.9914 from CPAN

17 files changed, 332 insertions, 168 deletions

diff --git a/cpan/version/lib/version.pm b/cpan/version/lib/version.pm
index f8afd8435b..d20427cc1c 100644
--- a/cpan/version/lib/version.pm
+++ b/cpan/version/lib/version.pm
@@ -3,10 +3,14 @@ package version;
 
 use 5.006002;
 use strict;
+use warnings::register;
+if ($] >= 5.015) {
+    warnings::register_categories(qw/version/);
+}
 
 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
 
-$VERSION = 0.9909;
+$VERSION = 0.9914;
 $CLASS = 'version';
 
 # avoid using Exporter
diff --git a/cpan/version/lib/version.pod b/cpan/version/lib/version.pod
index 40ceee2063..42691b1e0c 100644
--- a/cpan/version/lib/version.pod
+++ b/cpan/version/lib/version.pod
@@ -12,8 +12,8 @@ version - Perl extension for Version Objects
   # Declaring a dotted-decimal $VERSION (keep on one line!)
 
   use version; our $VERSION = version->declare("v1.2.3"); # formal
-  use version; our $VERSION = qv("v1.2.3");               # shorthand
-  use version; our $VERSION = qv("v1.2_3");               # alpha
+  use version; our $VERSION = qv("v1.2.3");               # deprecated
+  use version; our $VERSION = qv("v1.2_3");               # deprecated
 
   # Declaring an old-style decimal $VERSION (use quotes!)
 
@@ -270,7 +270,7 @@ Returns a value representing the object in a pure decimal form without
 trailing zeroes.
 
  version->declare('v1.2')->numify;  # 1.002
- version->parse('1.2')->numify;     # 1.2
+ version->parse('1.2')->numify;     # 1.200
 
 =head2 stringify()
 
diff --git a/cpan/version/lib/version/Internals.pod b/cpan/version/lib/version/Internals.pod
index 95be844881..dd784fe4c8 100644
--- a/cpan/version/lib/version/Internals.pod
+++ b/cpan/version/lib/version/Internals.pod
@@ -21,14 +21,14 @@ There are actually two distinct kinds of version objects:
 
 =over 4
 
-=item Decimal Versions
+=item Decimal versions
 
 Any version which "looks like a number", see L<Decimal Versions>.  This
 also includes versions with a single decimal point and a single embedded
 underscore, see L<Alpha Versions>, even though these must be quoted
 to preserve the underscore formatting.
 
-=item Dotted-Decimal Versions
+=item Dotted-Decimal versions
 
 Also referred to as "Dotted-Integer", these contains more than one decimal
 point and may have an optional embedded underscore, see L<Dotted-Decimal
diff --git a/cpan/version/lib/version/regex.pm b/cpan/version/lib/version/regex.pm
index f73296383a..dc769c28dd 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.9909;
+$VERSION = 0.9914;
 
 #--------------------------------------------------------------------------#
 # Version regexp components
diff --git a/cpan/version/t/01base.t b/cpan/version/t/01base.t
index 6174194b8a..4c1a23dd49 100644
--- a/cpan/version/t/01base.t
+++ b/cpan/version/t/01base.t
@@ -5,11 +5,14 @@
 #########################
 
 use Test::More qw/no_plan/;
+use File::Spec;
 
 BEGIN {
-    (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
+    my $coretests = File::Spec->catpath(
+        (File::Spec->splitpath($0))[0,1], 'coretests.pm'
+    );
     require $coretests;
-    use_ok('version', 0.9909);
+    use_ok('version', 0.9914);
 }
 
 BaseTests("version","new","qv");
diff --git a/cpan/version/t/02derived.t b/cpan/version/t/02derived.t
index a5aa2e48ff..ac0dea9130 100644
--- a/cpan/version/t/02derived.t
+++ b/cpan/version/t/02derived.t
@@ -5,12 +5,15 @@
 #########################
 
 use Test::More qw/no_plan/;
+use File::Spec;
 use File::Temp qw/tempfile/;
 
 BEGIN {
-    (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
+    my $coretests = File::Spec->catpath(
+        (File::Spec->splitpath($0))[0,1], 'coretests.pm'
+    );
     require $coretests;
-    use_ok("version", 0.9909);
+    use_ok("version", 0.9914);
     # If we made it this far, we are ok.
 }
 
diff --git a/cpan/version/t/03require.t b/cpan/version/t/03require.t
index f6100ef4f6..ed437be64f 100644
--- a/cpan/version/t/03require.t
+++ b/cpan/version/t/03require.t
@@ -5,16 +5,19 @@
 #########################
 
 use Test::More qw/no_plan/;
+use File::Spec;
 
 BEGIN {
-    (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
+    my $coretests = File::Spec->catpath(
+        (File::Spec->splitpath($0))[0,1], 'coretests.pm'
+    );
     require $coretests;
 }
 
 # 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.9909, "Make sure we have the correct class";
+is $version::VERSION, 0.9914, "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 0b82313df0..fad9139acf 100644
--- a/cpan/version/t/05sigdie.t
+++ b/cpan/version/t/05sigdie.t
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 BEGIN {
-    use version 0.9909;
+    use version 0.9914;
 }
 
 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 ed24602e41..e9f7187145 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.9909);
+    use_ok('version', 0.9914);
 }
 
 my $v1 = version->new('1.2');
diff --git a/cpan/version/t/07locale.t b/cpan/version/t/07locale.t
index 7af61b5725..22b9def883 100644
--- a/cpan/version/t/07locale.t
+++ b/cpan/version/t/07locale.t
@@ -7,11 +7,11 @@
 use File::Basename;
 use File::Temp qw/tempfile/;
 use POSIX qw/locale_h/;
-use Test::More tests => 7;
+use Test::More tests => 8;
 use Config;
 
 BEGIN {
-    use_ok('version', 0.9909);
+    use_ok('version', 0.9914);
 }
 
 SKIP: {
@@ -20,7 +20,7 @@ SKIP: {
 	    if(!$Config{d_setlocale});
 
 	# test locale handling
-	my $warning;
+	my $warning = '';
 
 	local $SIG{__WARN__} = sub { $warning = $_[0] };
 
@@ -38,7 +38,7 @@ SKIP: {
 	    $loc = setlocale( LC_ALL, $_);
 	    last if $loc && localeconv()->{decimal_point} eq ',';
 	}
-	skip 'Cannot test locale handling without a comma locale', 5
+	skip 'Cannot test locale handling without a comma locale', 6
 	    unless $loc and localeconv()->{decimal_point} eq ',';
 
 	setlocale(LC_NUMERIC, $loc);
@@ -50,11 +50,14 @@ SKIP: {
 	ok ($v eq "1.23", "Locale doesn't apply to version objects");
 	ok ($v == $ver, "Comparison to locale floating point");
 
+        TODO: { # Resolve https://rt.cpan.org/Ticket/Display.html?id=102272
+            local $TODO = 'Fails for Perl 5.x.0 < 5.19.0';
+            $ver = version->new($]);
+            is "$ver", "$]", 'Use PV for dualvars';
+        }
 	setlocale( LC_ALL, $orig_loc); # reset this before possible skip
 	skip 'Cannot test RT#46921 with Perl < 5.008', 1
 	    if ($] < 5.008);
-	skip 'Cannot test RT#46921 with pure Perl module', 1
-	    if exists $INC{'version/vpp.pm'};
 	my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
 	(my $package = basename($filename)) =~ s/\.pm$//;
 	print $fh <<"EOF";
@@ -79,169 +82,243 @@ EOF
 __DATA__
 af_ZA
 af_ZA.utf8
+af_ZA.UTF-8
 an_ES
 an_ES.utf8
+an_ES.UTF-8
 az_AZ.utf8
+az_AZ.UTF-8
 be_BY
 be_BY.utf8
+be_BY.UTF-8
 bg_BG
 bg_BG.utf8
+bg_BG.UTF-8
 br_FR
 br_FR@euro
 br_FR.utf8
+br_FR.UTF-8
 bs_BA
 bs_BA.utf8
+bs_BA.UTF-8
 ca_ES
 ca_ES@euro
 ca_ES.utf8
+ca_ES.UTF-8
 cs_CZ
 cs_CZ.utf8
+cs_CZ.UTF-8
 da_DK
 da_DK.utf8
+da_DK.UTF-8
 de_AT
 de_AT@euro
 de_AT.utf8
+de_AT.UTF-8
 de_BE
 de_BE@euro
 de_BE.utf8
+de_BE.UTF-8
 de_DE
 de_DE@euro
 de_DE.utf8
+de_DE.UTF-8
+de_DE.UTF-8
 de_LU
 de_LU@euro
 de_LU.utf8
+de_LU.UTF-8
 el_GR
 el_GR.utf8
+el_GR.UTF-8
 en_DK
 en_DK.utf8
+en_DK.UTF-8
 es_AR
 es_AR.utf8
+es_AR.UTF-8
 es_BO
 es_BO.utf8
+es_BO.UTF-8
 es_CL
 es_CL.utf8
+es_CL.UTF-8
 es_CO
 es_CO.utf8
+es_CO.UTF-8
 es_EC
 es_EC.utf8
+es_EC.UTF-8
 es_ES
 es_ES@euro
 es_ES.utf8
+es_ES.UTF-8
 es_PY
 es_PY.utf8
+es_PY.UTF-8
 es_UY
 es_UY.utf8
+es_UY.UTF-8
 es_VE
 es_VE.utf8
+es_VE.UTF-8
 et_EE
 et_EE.iso885915
 et_EE.utf8
+et_EE.UTF-8
 eu_ES
 eu_ES@euro
 eu_ES.utf8
+eu_ES.UTF-8
 fi_FI
 fi_FI@euro
 fi_FI.utf8
+fi_FI.UTF-8
 fo_FO
 fo_FO.utf8
+fo_FO.UTF-8
 fr_BE
 fr_BE@euro
 fr_BE.utf8
+fr_BE.UTF-8
 fr_CA
 fr_CA.utf8
+fr_CA.UTF-8
 fr_CH
 fr_CH.utf8
+fr_CH.UTF-8
 fr_FR
 fr_FR@euro
 fr_FR.utf8
+fr_FR.UTF-8
 fr_LU
 fr_LU@euro
 fr_LU.utf8
+fr_LU.UTF-8
 gl_ES
 gl_ES@euro
 gl_ES.utf8
+gl_ES.UTF-8
 hr_HR
 hr_HR.utf8
+hr_HR.UTF-8
 hu_HU
 hu_HU.utf8
+hu_HU.UTF-8
 id_ID
 id_ID.utf8
+id_ID.UTF-8
 is_IS
 is_IS.utf8
+is_IS.UTF-8
 it_CH
 it_CH.utf8
+it_CH.UTF-8
 it_IT
 it_IT@euro
 it_IT.utf8
+it_IT.UTF-8
 ka_GE
 ka_GE.utf8
+ka_GE.UTF-8
 kk_KZ
 kk_KZ.utf8
+kk_KZ.UTF-8
 kl_GL
 kl_GL.utf8
+kl_GL.UTF-8
 lt_LT
 lt_LT.utf8
+lt_LT.UTF-8
 lv_LV
 lv_LV.utf8
+lv_LV.UTF-8
 mk_MK
 mk_MK.utf8
+mk_MK.UTF-8
 mn_MN
 mn_MN.utf8
+mn_MN.UTF-8
 nb_NO
 nb_NO.utf8
+nb_NO.UTF-8
 nl_BE
 nl_BE@euro
 nl_BE.utf8
+nl_BE.UTF-8
 nl_NL
 nl_NL@euro
 nl_NL.utf8
+nl_NL.UTF-8
 nn_NO
 nn_NO.utf8
+nn_NO.UTF-8
 no_NO
 no_NO.utf8
+no_NO.UTF-8
 oc_FR
 oc_FR.utf8
+oc_FR.UTF-8
 pl_PL
 pl_PL.utf8
+pl_PL.UTF-8
 pt_BR
 pt_BR.utf8
+pt_BR.UTF-8
 pt_PT
 pt_PT@euro
 pt_PT.utf8
+pt_PT.UTF-8
 ro_RO
 ro_RO.utf8
+ro_RO.UTF-8
 ru_RU
 ru_RU.koi8r
 ru_RU.utf8
+ru_RU.UTF-8
 ru_UA
 ru_UA.utf8
+ru_UA.UTF-8
 se_NO
 se_NO.utf8
+se_NO.UTF-8
 sh_YU
 sh_YU.utf8
+sh_YU.UTF-8
 sk_SK
 sk_SK.utf8
+sk_SK.UTF-8
 sl_SI
 sl_SI.utf8
+sl_SI.UTF-8
 sq_AL
 sq_AL.utf8
+sq_AL.UTF-8
 sr_CS
 sr_CS.utf8
+sr_CS.UTF-8
 sv_FI
 sv_FI@euro
 sv_FI.utf8
+sv_FI.UTF-8
 sv_SE
 sv_SE.iso885915
 sv_SE.utf8
+sv_SE.UTF-8
 tg_TJ
 tg_TJ.utf8
+tg_TJ.UTF-8
 tr_TR
 tr_TR.utf8
+tr_TR.UTF-8
 tt_RU.utf8
+tt_RU.UTF-8
 uk_UA
 uk_UA.utf8
+uk_UA.UTF-8
 vi_VN
 vi_VN.tcvn
 wa_BE
 wa_BE@euro
 wa_BE.utf8
+wa_BE.UTF-8
diff --git a/cpan/version/t/08_corelist.t b/cpan/version/t/08_corelist.t
index d7829c1c92..d8cd147949 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.9909);
+use_ok("version", 0.9914);
 
 # 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 dbd387dbd4..bb6d3ec443 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.9909);
+use_ok("version", 0.9914);
 use Test::More;
 
 BEGIN {
diff --git a/cpan/version/t/10_lyon.t b/cpan/version/t/10_lyon.t
new file mode 100644
index 0000000000..4f927aa65f
--- /dev/null
+++ b/cpan/version/t/10_lyon.t
@@ -0,0 +1,44 @@
+#! perl
+
+use Test::More qw/no_plan/;
+
+use version;
+
+# These values are from the Lyon consensus, as taken from
+# https://gist.github.com/dagolden/9559280
+
+ok(version->new(1.0203) == version->new('1.0203'));
+ok(version->new(1.02_03) == version->new('1.02_03'));
+ok(version->new(v1.2.3) == version->new('v1.2.3'));
+if ($] >= 5.008_001) {
+    ok(version->new(v1.2.3_0) == version->new('v1.2.3_0'));
+}
+
+cmp_ok(version->new(1.0203), '==', version->new('1.0203'));
+cmp_ok(version->new(1.02_03), '==', version->new('1.02_03'));
+cmp_ok(version->new(v1.2.3), '==', version->new('v1.2.3'));
+if ($] >= 5.008_001) {
+    cmp_ok(version->new(v1.2.3_0), '==', version->new('v1.2.3_0'));
+}
+
+cmp_ok(version->new('1.0203')->numify, '==', '1.0203');
+is(version->new('1.0203')->normal, 'v1.20.300');
+
+cmp_ok(version->new('1.02_03')->numify, '==', '1.0203');
+is(version->new('1.02_03')->normal, 'v1.20.300');
+
+cmp_ok(version->new('v1.2.30')->numify, '==', '1.002030');
+is(version->new('v1.2.30')->normal, 'v1.2.30');
+cmp_ok(version->new('v1.2.3_0')->numify, '==', '1.002030');
+is(version->new('v1.2.3_0')->normal, 'v1.2.30');
+
+is(version->new("1.0203")->stringify, "1.0203");
+is(version->new("1.02_03")->stringify, "1.02_03");
+is(version->new("v1.2.30")->stringify, "v1.2.30");
+is(version->new("v1.2.3_0")->stringify, "v1.2.3_0");
+is(version->new(1.0203)->stringify, "1.0203");
+is(version->new(1.02_03)->stringify, "1.0203");
+is(version->new(v1.2.30)->stringify, "v1.2.30");
+if ($] >= 5.008_001) {
+    is(version->new(v1.2.3_0)->stringify, "v1.2.30");
+}
diff --git a/cpan/version/t/coretests.pm b/cpan/version/t/coretests.pm
index 17bf9ec5fc..07cc82e614 100644
--- a/cpan/version/t/coretests.pm
+++ b/cpan/version/t/coretests.pm
@@ -10,7 +10,7 @@ if ($Test::More::VERSION < 0.48) { # Fix for RT#48268
     *main::use_ok = sub ($;@) {
 	my ($pkg, $req, @args) = @_;
 	eval "use $pkg $req ".join(' ',@args);
-	is ${"$pkg\::VERSION"}, $req, 'Had to manually use version';
+	is ${"$pkg\::VERSION"}, eval($req), 'Had to manually use version';
 	# If we made it this far, we are ok.
     };
 }
@@ -132,8 +132,8 @@ sub BaseTests {
     ok ( $version != $new_version, '$version != $new_version' );
 
     $version = $CLASS->$method("1.2.4");
-    ok ( $version > $new_version, '$version > $new_version' );
-    ok ( $new_version < $version, '$new_version < $version' );
+    ok ( $version < $new_version, '$version < $new_version' );
+    ok ( $new_version > $version, '$new_version > $version' );
     ok ( $version != $new_version, '$version != $new_version' );
 
     # now test with alpha version form with object
@@ -146,24 +146,22 @@ sub BaseTests {
     ok ( $new_version->is_alpha, '$new_version->is_alpha');
 
     $version = $CLASS->$method("1.2.4");
-    ok ( $version > $new_version, '$version > $new_version' );
-    ok ( $new_version < $version, '$new_version < $version' );
+    ok ( $version < $new_version, '$version < $new_version' );
+    ok ( $new_version > $version, '$new_version > $version' );
     ok ( $version != $new_version, '$version != $new_version' );
 
-    $version = $CLASS->$method("1.2.3.4");
+    $version = $CLASS->$method("1.2.34");
     $new_version = $CLASS->$method("1.2.3_4");
-    ok ( $version > $new_version, '$version > $new_version' );
-    ok ( $new_version < $version, '$new_version < $version' );
-    ok ( $version != $new_version, '$version != $new_version' );
+    ok ( $version == $new_version, '$version == $new_version' );
 
-    $version = $CLASS->$method("v1.2.3");
-    $new_version = $CLASS->$method("1.2.3.0");
+    $version = $CLASS->$method("v1.2.30");
+    $new_version = $CLASS->$method("1.2.30.0");
     ok ( $version == $new_version, '$version == $new_version' );
     $new_version = $CLASS->$method("1.2.3_0");
     ok ( $version == $new_version, '$version == $new_version' );
-    $new_version = $CLASS->$method("1.2.3.1");
+    $new_version = $CLASS->$method("1.2.30.1");
     ok ( $version < $new_version, '$version < $new_version' );
-    $new_version = $CLASS->$method("1.2.3_1");
+    $new_version = $CLASS->$method("1.2.30_1");
     ok ( $version < $new_version, '$version < $new_version' );
     $new_version = $CLASS->$method("1.1.999");
     ok ( $version > $new_version, '$version > $new_version' );
@@ -348,9 +346,10 @@ SKIP: 	{
 	skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2
 		if $] lt 5.008_001;
 	$version = $CLASS->$method(v1.2.3_4);
-	is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4"');
+	$DB::single = 1;
+	is($version, "v1.2.34", '"$version" eq "v1.2.34"');
 	$version = $CLASS->$method(eval "v1.2.3_4");
-	is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4" (from eval)');
+	is($version, "v1.2.34", '"$version" eq "v1.2.34" (from eval)');
     }
 
     # trailing zero testing (reported by Andreas Koenig).
@@ -592,7 +591,48 @@ SKIP: {
 	eval {my $v = $CLASS->new({1 => 2}) };
 	like $@, qr/Invalid version format/, 'Do not crash for garbage';
     }
-
+    { # https://rt.cpan.org/Ticket/Display.html?id=93603
+	eval {my $v = $CLASS->$method('.1.')};
+	like $@, qr/trailing decimal/, 'Forbid trailing decimals';
+	eval {my $v = $CLASS->$method('.1.2.')};
+	like $@, qr/trailing decimal/, 'Forbid trailing decimals';
+    }
+    { # https://rt.cpan.org/Ticket/Display.html?id=93715
+	eval {my $v = $CLASS->new(v1.2)};
+	unlike $@, qr/non-numeric data/, 'Handle short v-strings';
+	eval {my $v = $CLASS->new(v1)};
+	unlike $@, qr/non-numeric data/, 'Handle short v-strings';
+    }
+    {
+	my $two31 = '2147483648';
+	my $v = $CLASS->new($two31);
+	is "$v", 'v.Inf', 'Element Exceeds VERSION_MAX';
+	like $warning, qr/Integer overflow in version/, 'Overflow warning';
+	$v = $CLASS->new("1.$two31.$two31");
+	is "$v", 'v.Inf', 'Element Exceeds VERSION_MAX';
+	like $warning, qr/Integer overflow in version/, 'Overflow warning';
+    }
+    {
+	# now as a number
+	$two31 = 2**31;
+	$v = $CLASS->new($two31);
+	is "$v", 'v.Inf', 'Element Exceeds VERSION_MAX';
+	like $warning, qr/Integer overflow in version/, 'Overflow warning';
+    }
+    { # https://rt.cpan.org/Ticket/Display.html?id=101628
+	undef $warning;
+	$v = $CLASS->new('1.1.00000000010');
+	is $v->normal, "v1.1.10", 'Ignore leading zeros';
+	unlike $warning, qr/Integer overflow in version/, 'No overflow warning';
+    }
+    { # https://rt.cpan.org/Ticket/Display.html?id=93340
+	$v = $CLASS->parse(q[2.6_01]);
+	is $v->normal, 'v2.601.0', 'Normal strips underscores from alphas'
+    }
+    { # https://rt.cpan.org/Ticket/Display.html?id=98744
+	$v = $CLASS->new("1.02_003");
+	is $v->numify, '1.020030', 'Ignore underscores for numify';
+    }
 }
 
 1;
diff --git a/vutil.c b/vutil.c
index 20fb522ee5..e43d2b2788 100644
--- a/vutil.c
+++ b/vutil.c
@@ -1,25 +1,13 @@
 /* This file is part of the "version" CPAN distribution.  Please avoid
    editing it in the perl core. */
 
-#ifndef PERL_CORE
-#  define PERL_NO_GET_CONTEXT
-#  include "EXTERN.h"
-#  include "perl.h"
-#  include "XSUB.h"
-#  define NEED_my_snprintf
-#  define NEED_newRV_noinc
-#  define NEED_vnewSVpvf
-#  define NEED_newSVpvn_flags_GLOBAL
-#  define NEED_warner
-#  include "ppport.h"
+#ifdef PERL_CORE
+#  include "vutil.h"
 #endif
-#include "vutil.h"
 
 #define VERSION_MAX 0x7FFFFFFF
 
 /*
-=head1 Versioning
-
 =for apidoc prescan_version
 
 Validate that a given string can be parsed as a version object, but doesn't
@@ -43,7 +31,7 @@ Perl_prescan_version(pTHX_ const char *s, bool strict,
     bool alpha = FALSE;
     const char *d = s;
 
-    PERL_ARGS_ASSERT_PRESCAN_VERSION;
+    PERL_ARGS_ASSERT_PRESCAN_VERSION; PERL_UNUSED_CONTEXT;
 
     if (qv && isDIGIT(*d))
 	goto dotted_decimal_version;
@@ -226,6 +214,11 @@ version_prescan_finish:
 	/* trailing non-numeric data */
 	BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
     }
+    if (saw_decimal > 1 && d[-1] == '.') {
+	/* no trailing period allowed */
+	BADVERSION(s,errstr,"Invalid version format (trailing decimal)");
+    }
+
 
     if (sqv)
 	*sqv = qv;
@@ -312,7 +305,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     if ( !qv && width < 3 )
 	(void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
 
-    while (isDIGIT(*pos))
+    while (isDIGIT(*pos) || *pos == '_')
 	pos++;
     if (!isALPHA(*pos)) {
 	I32 rev;
@@ -332,6 +325,8 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 		if ( !qv && s > start && saw_decimal == 1 ) {
 		    mult *= 100;
  		    while ( s < end ) {
+			if (*s == '_')
+			    continue;
 			orev = rev;
  			rev += (*s - '0') * mult;
  			mult /= 10;
@@ -350,17 +345,27 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
   		}
  		else {
  		    while (--end >= s) {
-			orev = rev;
- 			rev += (*end - '0') * mult;
- 			mult *= 10;
-			if (   (PERL_ABS(orev) > PERL_ABS(rev)) 
-			    || (PERL_ABS(rev) > VERSION_MAX )) {
+			int i;
+			if (*end == '_')
+			    continue;
+			i = (*end - '0');
+                        if (   (mult == VERSION_MAX)
+                            || (i > VERSION_MAX / mult)
+                            || (i * mult > VERSION_MAX - rev))
+                        {
 			    Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), 
 					   "Integer overflow in version");
 			    end = s - 1;
 			    rev = VERSION_MAX;
 			    vinf = 1;
 			}
+                        else
+                            rev += i * mult;
+
+                        if (mult > VERSION_MAX / 10)
+                            mult = VERSION_MAX;
+                        else
+                            mult *= 10;
  		    }
  		} 
   	    }
@@ -371,8 +376,14 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 		s = last;
 		break;
 	    }
-	    else if ( *pos == '.' )
-		s = ++pos;
+	    else if ( *pos == '.' ) {
+		pos++;
+		if (qv) {
+		    while (*pos == '0')
+			++pos;
+		}
+		s = pos;
+	    }
 	    else if ( *pos == '_' && isDIGIT(pos[1]) )
 		s = ++pos;
 	    else if ( *pos == ',' && isDIGIT(pos[1]) )
@@ -384,7 +395,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 		break;
 	    }
 	    if ( qv ) {
-		while ( isDIGIT(*pos) )
+		while ( isDIGIT(*pos) || *pos == '_')
 		    pos++;
 	    }
 	    else {
@@ -461,7 +472,6 @@ Perl_new_version2(pTHX_ SV *ver)
 Perl_new_version(pTHX_ SV *ver)
 #endif
 {
-    dVAR;
     SV * const rv = newSV(0);
     PERL_ARGS_ASSERT_NEW_VERSION;
     if ( ISA_VERSION_OBJ(ver) ) /* can just copy directly */
@@ -515,7 +525,16 @@ Perl_new_version(pTHX_ SV *ver)
 	if ( mg ) { /* already a v-string */
 	    const STRLEN len = mg->mg_len;
 	    const char * const version = (const char*)mg->mg_ptr;
+	    char *raw, *under;
+	    static const char underscore[] = "_";
 	    sv_setpvn(rv,version,len);
+	    raw = SvPV_nolen(rv);
+	    under = ninstr(raw, raw+len, underscore, underscore + 1);
+	    if (under) {
+		Move(under + 1, under, raw + len - under - 1, char);
+		SvCUR(rv)--;
+		*SvEND(rv) = '\0';
+	    }
 	    /* this is for consistency with the pure Perl class */
 	    if ( isDIGIT(*version) )
 		sv_insert(rv, 0, 0, "v", 1);
@@ -591,35 +610,45 @@ VER_NV:
 	char tbuf[64];
 	SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
 	char *buf;
+
+#if PERL_VERSION_GE(5,19,0)
+	if (SvPOK(ver)) {
+	    /* dualvar? */
+	    goto VER_PV;
+	}
+#endif
+
 #ifdef USE_LOCALE_NUMERIC
-        const char * const cur_numeric = setlocale(LC_NUMERIC, NULL);
-        assert(cur_numeric);
-
-        /* XS code can set the locale without us knowing.  To protect the
-         * version number parsing, which requires the radix character to be a
-         * dot, update our records as to what the locale is, so that our
-         * existing macro mechanism can correctly change it to a dot and back
-         * if necessary.  This code is extremely unlikely to be in a loop, so
-         * the extra work will have a negligible performance impact.  See [perl
-         * #121930].
-         *
-         * If the current locale is a standard one, but we are expecting it to
-         * be a different, underlying locale, update our records to make the
-         * underlying locale this (standard) one.  If the current locale is not
-         * a standard one, we should be expecting a non-standard one, the same
-         * one that we have recorded as the underlying locale.  If not, update
-         * our records. */
-        if (strEQ(cur_numeric, "C") || strEQ(cur_numeric, "POSIX")) {
-            if (! PL_numeric_standard) {
-                new_numeric(cur_numeric);
-            }
-        }
-        else if (PL_numeric_standard
-                 || ! PL_numeric_name
-                 || strNE(PL_numeric_name, cur_numeric))
-        {
-            new_numeric(cur_numeric);
-        }
+	{
+	    const char * const cur_numeric = setlocale(LC_NUMERIC, NULL);
+	    assert(cur_numeric);
+
+	    /* XS code can set the locale without us knowing.  To protect the
+	     * version number parsing, which requires the radix character to be a
+	     * dot, update our records as to what the locale is, so that our
+	     * existing macro mechanism can correctly change it to a dot and back
+	     * if necessary.  This code is extremely unlikely to be in a loop, so
+	     * the extra work will have a negligible performance impact.  See [perl
+	     * #121930].
+	     *
+	     * If the current locale is a standard one, but we are expecting it to
+	     * be a different, underlying locale, update our records to make the
+	     * underlying locale this (standard) one.  If the current locale is not
+	     * a standard one, we should be expecting a non-standard one, the same
+	     * one that we have recorded as the underlying locale.  If not, update
+	     * our records. */
+	    if (strEQ(cur_numeric, "C") || strEQ(cur_numeric, "POSIX")) {
+		if (! PL_numeric_standard) {
+		    new_numeric(cur_numeric);
+		}
+	    }
+	    else if (PL_numeric_standard
+		     || ! PL_numeric_name
+		     || strNE(PL_numeric_name, cur_numeric))
+	    {
+		new_numeric(cur_numeric);
+	    }
+	}
 #endif
         { /* Braces needed because macro just below declares a variable */
         STORE_NUMERIC_LOCAL_SET_STANDARD();
@@ -650,9 +679,7 @@ VER_NV:
     }
 #endif
     else if ( SvPOK(ver))/* must be a string or something like a string */
-#if PERL_VERSION_LT(5,17,2)
 VER_PV:
-#endif
     {
 	STRLEN len;
 	version = savepvn(SvPV(ver,len), SvCUR(ver));
@@ -800,7 +827,6 @@ Perl_vnumify(pTHX_ SV *vs)
 {
     SSize_t i, len;
     I32 digit;
-    int width;
     bool alpha = FALSE;
     SV *sv;
     AV *av;
@@ -815,14 +841,11 @@ Perl_vnumify(pTHX_ SV *vs)
     /* see if various flags exist */
     if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
 	alpha = TRUE;
-    {
-	SV ** svp = hv_fetchs(MUTABLE_HV(vs), "width", FALSE);
-	if ( svp )
-	    width = SvIV(*svp);
-	else
-	    width = 3;
-    }
 
+    if (alpha) {
+	Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
+		       "alpha->numify() is lossy");
+    }
 
     /* attempt to retrieve the version array */
     if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) {
@@ -840,30 +863,14 @@ Perl_vnumify(pTHX_ SV *vs)
 	digit = SvIV(tsv);
     }
     sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
-    for ( i = 1 ; i < len ; i++ )
+    for ( i = 1 ; i <= len ; i++ )
     {
 	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);
-	    Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, term.quot, term.rem);
-	}
-	else {
-	    Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
-	}
+	Perl_sv_catpvf(aTHX_ sv, "%03d", (int)digit);
     }
 
-    if ( 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);
-    }
-    else /* len == 0 */
-    {
+    if ( len == 0 ) {
 	sv_catpvs(sv, "000");
     }
     return sv;
@@ -906,6 +913,7 @@ Perl_vnormal(pTHX_ SV *vs)
 
     if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
 	alpha = TRUE;
+
     av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)));
 
     len = av_len(av);
@@ -918,23 +926,12 @@ Perl_vnormal(pTHX_ SV *vs)
 	digit = SvIV(tsv);
     }
     sv = Perl_newSVpvf(aTHX_ "v%"IVdf, (IV)digit);
-    for ( i = 1 ; i < len ; i++ ) {
+    for ( i = 1 ; i <= len ; i++ ) {
 	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 */
-	SV * tsv = *av_fetch(av, len, 0);
-	digit = SvIV(tsv);
-	if ( alpha )
-	    Perl_sv_catpvf(aTHX_ sv, "_%"IVdf, (IV)digit);
-	else
-	    Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
-    }
-
     if ( len <= 2 ) { /* short version, must be at least three */
 	for ( len = 2 - len; len != 0; len-- )
 	    sv_catpvs(sv,".0");
@@ -1048,19 +1045,6 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
 	i++;
     }
 
-    /* tiebreaker for alpha with identical terms */
-    if ( retval == 0 && l == r && left == right && ( lalpha || ralpha ) )
-    {
-	if ( lalpha && !ralpha )
-	{
-	    retval = -1;
-	}
-	else if ( ralpha && !lalpha)
-	{
-	    retval = +1;
-	}
-    }
-
     if ( l != r && retval == 0 ) /* possible match except for trailing 0's */
     {
 	if ( l < r )
@@ -1086,3 +1070,5 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
     }
     return retval;
 }
+
+/* ex: set ro: */
diff --git a/vutil.h b/vutil.h
index aaf2284e89..a60ca9d479 100644
--- a/vutil.h
+++ b/vutil.h
@@ -131,16 +131,16 @@ S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
 
 #  define VUTIL_REPLACE_CORE 1
 
-const char * Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv);
-SV * Perl_new_version2(pTHX_ SV *ver);
-SV * Perl_upg_version2(pTHX_ SV *sv, bool qv);
-SV * Perl_vstringify2(pTHX_ SV *vs);
-SV * Perl_vverify2(pTHX_ SV *vs);
-SV * Perl_vnumify2(pTHX_ SV *vs);
-SV * Perl_vnormal2(pTHX_ SV *vs);
-SV * Perl_vstringify2(pTHX_ SV *vs);
-int Perl_vcmp2(pTHX_ SV *lsv, SV *rsv);
-const char * Perl_prescan_version2(pTHX_ const char *s, bool strict, const char** errstr, bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha);
+static const char * Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv);
+static SV * Perl_new_version2(pTHX_ SV *ver);
+static SV * Perl_upg_version2(pTHX_ SV *sv, bool qv);
+static SV * Perl_vstringify2(pTHX_ SV *vs);
+static SV * Perl_vverify2(pTHX_ SV *vs);
+static SV * Perl_vnumify2(pTHX_ SV *vs);
+static SV * Perl_vnormal2(pTHX_ SV *vs);
+static SV * Perl_vstringify2(pTHX_ SV *vs);
+static int Perl_vcmp2(pTHX_ SV *lsv, SV *rsv);
+static const char * Perl_prescan_version2(pTHX_ const char *s, bool strict, const char** errstr, bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha);
 
 #  define SCAN_VERSION(a,b,c)	Perl_scan_version2(aTHX_ a,b,c)
 #  define NEW_VERSION(a)	Perl_new_version2(aTHX_ a)
@@ -239,3 +239,13 @@ const char * Perl_prescan_version(pTHX_ const char *s, bool strict, const char**
 #  define RESTORE_NUMERIC_LOCAL()
 # endif
 #endif
+
+#ifndef LOCK_NUMERIC_STANDARD
+#define LOCK_NUMERIC_STANDARD()
+#endif
+
+#ifndef UNLOCK_NUMERIC_STANDARD
+#define UNLOCK_NUMERIC_STANDARD()
+#endif
+
+/* ex: set ro: */
diff --git a/vxs.inc b/vxs.inc
index 4d74adbd06..a047b2c171 100644
--- a/vxs.inc
+++ b/vxs.inc
@@ -12,7 +12,12 @@
 /* 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)); XS(VXSp(name))
+
+#ifndef XS_INTERNAL
+#  define XS_INTERNAL(name) static XSPROTO(name)
+#endif
+
+#define VXS(name) XS_INTERNAL(VXSp(name)); XS_INTERNAL(VXSp(name))
 
 /* uses PUSHs, so SP must be at start, PUSHs sv on Perl stack, then returns from
    xsub; this is a little more machine code/tailcall friendly than mPUSHs(foo);
@@ -86,7 +91,6 @@ typedef char HVNAME;
 
 VXS(universal_version)
 {
-    dVAR;
     dXSARGS;
     HV *pkg;
     GV **gvp;
@@ -185,7 +189,6 @@ VXS(universal_version)
 
 VXS(version_new)
 {
-    dVAR;
     dXSARGS;
     SV *vs;
     SV *rv;
@@ -225,7 +228,6 @@ VXS(version_new)
     default:
     case 0:
         Perl_croak_nocontext("Usage: version::new(class, version)");
-        break;
     }
 
     svarg0 = ST(0);
@@ -267,7 +269,6 @@ VXS(version_new)
 
 VXS(version_stringify)
 {
-     dVAR;
      dXSARGS;
      if (items < 1)
 	 croak_xs_usage(cv, "lobj, ...");
@@ -282,7 +283,6 @@ VXS(version_stringify)
 
 VXS(version_numify)
 {
-     dVAR;
      dXSARGS;
      if (items < 1)
 	 croak_xs_usage(cv, "lobj, ...");
@@ -296,7 +296,6 @@ VXS(version_numify)
 
 VXS(version_normal)
 {
-     dVAR;
      dXSARGS;
      if (items != 1)
 	 croak_xs_usage(cv, "ver");
@@ -311,7 +310,6 @@ VXS(version_normal)
 
 VXS(version_vcmp)
 {
-     dVAR;
      dXSARGS;
      if (items < 1)
 	 croak_xs_usage(cv, "lobj, ...");
@@ -347,7 +345,6 @@ VXS(version_vcmp)
 
 VXS(version_boolean)
 {
-    dVAR;
     dXSARGS;
     SV *lobj;
     if (items < 1)
@@ -368,7 +365,6 @@ VXS(version_boolean)
 
 VXS(version_noop)
 {
-    dVAR;
     dXSARGS;
     if (items < 1)
 	croak_xs_usage(cv, "lobj, ...");
@@ -383,7 +379,6 @@ static
 void
 S_version_check_key(pTHX_ CV * cv, const char * key, int keylen)
 {
-    dVAR;
     dXSARGS;
     if (items != 1)
 	croak_xs_usage(cv, "lobj");
@@ -408,7 +403,6 @@ VXS(version_is_alpha)
 
 VXS(version_qv)
 {
-    dVAR;
     dXSARGS;
     PERL_UNUSED_ARG(cv);
     SP -= items;