diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-11-22 22:34:07 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-11-23 06:04:43 -0800 |
| commit | c2a3bbbf95242da21477313087361902cd3b026e (patch) | |
| tree | 2afc45eac8b6375dc5ad07e05627600b8b0f1444 | |
| parent | 47a0660e68fc38d8d2ff11855d0d5fa5e2af0b82 (diff) | |
| download | perl-c2a3bbbf95242da21477313087361902cd3b026e.tar.gz | |
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.
| -rw-r--r-- | t/op/universal.t | 9 | ||||
| -rw-r--r-- | universal.c | 4 |
2 files changed, 10 insertions, 3 deletions
diff --git a/t/op/universal.t b/t/op/universal.t index 9999ca1971..991a6f3740 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 b62a92370b..57650e8f68 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) ); } |