From c2a3bbbf95242da21477313087361902cd3b026e Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Tue, 22 Nov 2011 22:34:07 -0800 Subject: [PATCH] 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. --- t/op/universal.t | 9 ++++++++- universal.c | 4 ++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/t/op/universal.t b/t/op/universal.t index 9999ca1..991a6f3 100644 --- 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 --- 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) ); } -- 2.7.4