Bring core up to version-0.9902

The attached patch bring the core Perl version code (including a fairly
significant leak when run in a tight loop) up to parity with CPAN
0.9902.  This deals with all open issues except:

   https://rt.cpan.org/Ticket/Display.html?id=81294

which I am having a hard time modeling.

John

Signed-off-by: Chris 'BinGOs' Williams <chris@bingosnet.co.uk>

9 files changed, 36 insertions, 20 deletions

diff --git a/lib/version.pm b/lib/version.pm
index 286dc790ff..27774bd9c2 100644
--- a/lib/version.pm
+++ b/lib/version.pm
@@ -6,7 +6,7 @@ use strict;
 
 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
 
-$VERSION = 0.9901;
+$VERSION = 0.9902;
 
 $CLASS = 'version';
 
diff --git a/lib/version/t/01base.t b/lib/version/t/01base.t
index c84531d0c5..9aa8052a30 100644
--- a/lib/version/t/01base.t
+++ b/lib/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.9901);
+    use_ok('version', 0.9902);
 }
 
 diag "Tests with base class" unless $ENV{PERL_CORE};
@@ -32,3 +32,15 @@ my $v = eval {
     return IO::Handle->VERSION;
 };
 ok defined($v), 'Fix for RT #47980';
+
+{ # https://rt.cpan.org/Ticket/Display.html?id=81085
+    eval { version::new() };
+    like $@, qr'Usage: version::new\(class, version\)',
+	'No bus err when called as function';
+    eval { $x = 1; print version::new };
+    like $@, qr'Usage: version::new\(class, version\)',
+	'No implicit object creation when called as function';
+    eval { $x = "version"; print version::new };
+    like $@, qr'Usage: version::new\(class, version\)',
+	'No implicit object creation when called as function';
+}
diff --git a/lib/version/t/02derived.t b/lib/version/t/02derived.t
index ea683a9bb5..c7afe0f9af 100644
--- a/lib/version/t/02derived.t
+++ b/lib/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.9901);
+    use_ok("version", 0.9902);
     # If we made it this far, we are ok.
 }
 
diff --git a/lib/version/t/03require.t b/lib/version/t/03require.t
index 3d99cb19e4..66c6bd3a85 100644
--- a/lib/version/t/03require.t
+++ b/lib/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.9901, "Make sure we have the correct class";
+is $version::VERSION, 0.9902, "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/lib/version/t/05sigdie.t b/lib/version/t/05sigdie.t
index dd785d58b7..188f185587 100644
--- a/lib/version/t/05sigdie.t
+++ b/lib/version/t/05sigdie.t
@@ -15,7 +15,7 @@ BEGIN {
 
 
 BEGIN {
-    use version 0.9901;
+    use version 0.9902;
 }
 
 pass "Didn't get caught by the wrong DIE handler, which is a good thing";
diff --git a/lib/version/t/06noop.t b/lib/version/t/06noop.t
index ff556ad214..9d113ed6e4 100644
--- a/lib/version/t/06noop.t
+++ b/lib/version/t/06noop.t
@@ -7,7 +7,7 @@
 use Test::More qw/no_plan/;
 
 BEGIN {
-    use_ok('version', 0.9901);
+    use_ok('version', 0.9902);
 }
 
 my $v1 = version->new('1.2');
diff --git a/lib/version/t/07locale.t b/lib/version/t/07locale.t
index a2005f8a92..3b67f3d77a 100644
--- a/lib/version/t/07locale.t
+++ b/lib/version/t/07locale.t
@@ -11,7 +11,7 @@ use Test::More tests => 7;
 use Config;
 
 BEGIN {
-    use_ok('version', 0.9901);
+    use_ok('version', 0.9902);
 }
 
 SKIP: {
diff --git a/universal.c b/universal.c
index f58381746d..a72c072a60 100644
--- a/universal.c
+++ b/universal.c
@@ -490,7 +490,7 @@ XS(XS_version_new)
 {
     dVAR;
     dXSARGS;
-    if (items > 3)
+    if (items > 3 || items < 1)
 	croak_xs_usage(cv, "class, version");
     SP -= items;
     {
diff --git a/util.c b/util.c
index a3fbd3c30c..2c745bfd6c 100644
--- a/util.c
+++ b/util.c
@@ -4500,7 +4500,7 @@ it doesn't.
 const char *
 Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 {
-    const char *start;
+    const char *start = s;
     const char *pos;
     const char *last;
     const char *errstr = NULL;
@@ -4508,17 +4508,11 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     int width = 3;
     bool alpha = FALSE;
     bool vinf = FALSE;
-    AV * const av = newAV();
-    SV * const hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
+    AV * av;
+    SV * hv;
 
     PERL_ARGS_ASSERT_SCAN_VERSION;
 
-    (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
-
-#ifndef NODEFAULT_SHAREKEYS
-    HvSHAREKEYS_on(hv);         /* key-sharing on by default */
-#endif
-
     while (isSPACE(*s)) /* leading whitespace is OK */
 	s++;
 
@@ -4526,6 +4520,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     if (errstr) {
 	/* "undef" is a special case and not an error */
 	if ( ! ( *s == 'u' && strEQ(s,"undef")) ) {
+	    Safefree(start);
 	    Perl_croak(aTHX_ "%s", errstr);
 	}
     }
@@ -4535,13 +4530,22 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 	s++;
     pos = s;
 
+    /* Now that we are through the prescan, start creating the object */
+    av = newAV();
+    hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
+    (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
+
+#ifndef NODEFAULT_SHAREKEYS
+    HvSHAREKEYS_on(hv);         /* key-sharing on by default */
+#endif
+
     if ( qv )
 	(void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv));
     if ( alpha )
 	(void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha));
     if ( !qv && width < 3 )
 	(void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
-    
+
     while (isDIGIT(*pos))
 	pos++;
     if (!isALPHA(*pos)) {
@@ -4712,7 +4716,7 @@ 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));
@@ -4846,7 +4850,7 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 		    }
 
 		    /* is definitely a v-string */
-		    if ( saw_decimal >= 2 ) {	
+		    if ( saw_decimal >= 2 ) {
 			Safefree(version);
 			version = nver;
 		    }