diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-11-23 09:48:01 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-11-24 01:45:28 -0800 |
| commit | e7b3543f6af45d688fdf0fc6a64c6f9988436cc6 (patch) | |
| tree | 39fc5f2caab760f2c9134d1032f5c7defc047139 | |
| parent | 5bcd1ef4a02daf3152ee41becf0004a7e450d106 (diff) | |
| download | perl-e7b3543f6af45d688fdf0fc6a64c6f9988436cc6.tar.gz | |
Produce right error msg for $ver < "version"
"version" was being treated as a version object and then failing
the validation check. It should be treated as a string, just like
"versions":
$ perl5.15.4 -Ilib -e '$^V < "version"'
Invalid version object at -e line 1.
$ perl5.15.4 -Ilib -e '$^V < "versions"'
Invalid version format (dotted-decimal versions require at least three parts) at -e line 1.
See also perl #102586.
| -rw-r--r-- | lib/version.t | 5 | ||||
| -rw-r--r-- | universal.c | 2 |
2 files changed, 6 insertions, 1 deletions
diff --git a/lib/version.t b/lib/version.t index da1102378a..ce46fa283b 100644 --- a/lib/version.t +++ b/lib/version.t @@ -328,6 +328,11 @@ sub BaseTests { $new_version = $CLASS->$method("1.1.999"); ok ( $version > $new_version, '$version > $new_version' ); + diag "test with version class names" unless $ENV{PERL_CORE}; + $version = $CLASS->$method("v1.2.3"); + eval { $version < $CLASS }; + like $@, qr/^Invalid version format/, "error with $version < $CLASS"; + # that which is not expressly permitted is forbidden diag "forbidden operations" unless $ENV{PERL_CORE}; ok ( !eval { ++$version }, "noop ++" ); diff --git a/universal.c b/universal.c index 57650e8f68..aeefca80ba 100644 --- a/universal.c +++ b/universal.c @@ -615,7 +615,7 @@ XS(XS_version_vcmp) SV * robj = ST(1); const IV swap = (IV)SvIV(ST(2)); - if ( ! sv_derived_from(robj, "version") ) + if ( ! sv_derived_from(robj, "version") || !SvROK(robj) ) { robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP)); sv_2mortal(robj); |