From e7b3543f6af45d688fdf0fc6a64c6f9988436cc6 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Wed, 23 Nov 2011 09:48:01 -0800 Subject: 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. --- lib/version.t | 5 +++++ universal.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) 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); -- cgit v1.2.1