[perl #95544] Make UNIVERSAL::VERSION return $VERSION

With this patch:
$ ./miniperl -le ' $VERSION = "3alpha"; print "main"->VERSION'
3alpha
$ ./miniperl -le ' $VERSION = "3alpha"; print "main"->VERSION(4)'
Invalid version format (non-numeric data) at -e line 1.

See the discussion starting at:
http://www.nntp.perl.org/group/perl.perl5.porters/2011/06/msg173710.html

Basically, this patch allows custom version parsers to call ->VERSION
to retrieve the version, even if the default parser would choke on it.

1 files changed, 8 insertions, 11 deletions

diff --git a/universal.c b/universal.c
index 3295fc51d9..c891b54bcf 100644
--- a/universal.c
+++ b/universal.c
@@ -311,6 +311,7 @@ XS(XS_UNIVERSAL_VERSION)
     GV **gvp;
     GV *gv;
     SV *sv;
+    SV *ret;
     const char *undef;
     PERL_UNUSED_ARG(cv);
 
@@ -327,15 +328,12 @@ XS(XS_UNIVERSAL_VERSION)
     gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
 
     if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
-        SV * const nsv = sv_newmortal();
-        sv_setsv(nsv, sv);
-        sv = nsv;
-	if ( !sv_derived_from(sv, "version"))
-	    upg_version(sv, FALSE);
+        ret = sv_newmortal();
+        sv_setsv(ret, sv);
         undef = NULL;
     }
     else {
-        sv = &PL_sv_undef;
+        sv = ret = &PL_sv_undef;
         undef = "(undef)";
     }
 
@@ -355,6 +353,9 @@ XS(XS_UNIVERSAL_VERSION)
 	     }
 	}
 
+	if ( !sv_derived_from(sv, "version"))
+	    upg_version(sv, FALSE);
+
 	if ( !sv_derived_from(req, "version")) {
 	    /* req may very well be R/O, so create a new object */
 	    req = sv_2mortal( new_version(req) );
@@ -376,11 +377,7 @@ XS(XS_UNIVERSAL_VERSION)
 
     }
 
-    if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
-	ST(0) = sv_2mortal(vstringify(sv));
-    } else {
-	ST(0) = sv;
-    }
+    ST(0) = ret;
 
     XSRETURN(1);
 }