support for version vectors in UNIVERSAL::VERSION(), so that

C<use Foo v1.2.3> etc., work; tests for the same

TODO: XS_VERSION_BOOTCHECK needs to be revisited in light of this

p4raw-id: //depot/perl@5265

1 files changed, 50 insertions, 7 deletions

diff --git a/universal.c b/universal.c
index 6ccff2f003..0e5a89b2c0 100644
--- a/universal.c
+++ b/universal.c
@@ -197,11 +197,10 @@ XS(XS_UNIVERSAL_VERSION)
     GV *gv;
     SV *sv;
     char *undef;
-    NV req;
 
-    if(SvROK(ST(0))) {
+    if (SvROK(ST(0))) {
         sv = (SV*)SvRV(ST(0));
-        if(!SvOBJECT(sv))
+        if (!SvOBJECT(sv))
             Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
         pkg = SvSTASH(sv);
     }
@@ -222,12 +221,56 @@ XS(XS_UNIVERSAL_VERSION)
         undef = "(undef)";
     }
 
-    if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) {
-	STRLEN n_a;
-	Perl_croak(aTHX_ "%s version %s required--this is only version %s",
-	      HvNAME(pkg), SvPV(ST(1),n_a), undef ? undef : SvPV(sv,n_a));
+    if (items > 1) {
+	STRLEN len;
+	SV *req = ST(1);
+
+	if (undef)
+	    Perl_croak(aTHX_ "%s does not define $%s::VERSION--version check failed",
+		       HvNAME(pkg), HvNAME(pkg));
+
+	if (!SvNIOK(sv) && SvPOK(sv)) {
+	    char *str = SvPVx(sv,len);
+	    while (len) {
+		--len;
+		/* XXX could DWIM "1.2.3" here */
+		if (!isDIGIT(str[len]) && str[len] != '.' && str[len] != '_')
+		    break;
+	    }
+	    if (len) {
+		if (SvNIOKp(req) && SvPOK(req)) {
+		    /* they said C<use Foo v1.2.3> and $Foo::VERSION
+		     * doesn't look like a float: do string compare */
+		    if (sv_cmp(req,sv) == 1) {
+			Perl_croak(aTHX_ "%s version v%vd required--"
+				   "this is only version v%vd",
+				   HvNAME(pkg), req, sv);
+		    }
+		    goto finish;
+		}
+		/* they said C<use Foo 1.002_003> and $Foo::VERSION
+		 * doesn't look like a float: force numeric compare */
+		SvUPGRADE(sv, SVt_PVNV);
+		SvNVX(sv) = str_to_version(sv);
+		SvPOK_off(sv);
+		SvNOK_on(sv);
+	    }
+	}
+	/* if we get here, we're looking for a numeric comparison,
+	 * so force the required version into a float, even if they
+	 * said C<use Foo v1.2.3> */
+	if (SvNIOKp(req) && SvPOK(req)) {
+	    NV n = SvNV(req);
+	    req = sv_newmortal();
+	    sv_setnv(req, n);
+	}
+
+	if (SvNV(req) > SvNV(sv))
+	    Perl_croak(aTHX_ "%s version %s required--this is only version %s",
+		  HvNAME(pkg), SvPV(req,len), SvPV(sv,len));
     }
 
+finish:
     ST(0) = sv;
 
     XSRETURN(1);