UNIVERSAL::VERSION should treat "version" as a string

It was treating it as a version object and then failing the validation
test, instead of treating it as an invalid version format, as it does
with "versions":

$ ./perl -Ilib -e'$VERSION = "versions"; main->VERSION(1)'
Invalid version format (dotted-decimal versions require at least three parts) at -e line 1.
$ ./perl -Ilib -e'$VERSION = "version"; main->VERSION(1)'
Invalid version object at -e line 1.

See also perl #102586.

diff --git a/t/op/universal.t b/t/op/universal.t
index 9999ca1..991a6f3 100644 (file)
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -10,7 +10,7 @@ BEGIN {
     require "./test.pl";
 }
 
-plan tests => 129;
+plan tests => 133;
 
 $a = {};
 bless $a, "Bob";
@@ -122,6 +122,13 @@ like $@, qr/^Alice version 2.719 required--this is only version 2.718 at /;
 ok (eval { $a->VERSION(2.718) });
 is $@, '';
 
+ok ! (eval { $a->VERSION("version") });
+like $@, qr/^Invalid version format/;
+
+$aversion::VERSION = "version";
+ok ! (eval { aversion->VERSION(2.719) });
+like $@, qr/^Invalid version format/;
+
 my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
 ## The test for import here is *not* because we want to ensure that UNIVERSAL
 ## can always import; it is an historical accident that UNIVERSAL can import.

diff --git a/universal.c b/universal.c
index b62a923..57650e8 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -449,10 +449,10 @@ XS(XS_UNIVERSAL_VERSION)
             }
        }
 
-       if ( !sv_derived_from(sv, "version"))
+       if ( !sv_derived_from(sv, "version") || !SvROK(sv))
            upg_version(sv, FALSE);
 
-       if ( !sv_derived_from(req, "version")) {
+       if ( !sv_derived_from(req, "version") || !SvROK(req)) {
            /* req may very well be R/O, so create a new object */
            req = sv_2mortal( new_version(req) );
        }