diff options
| -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); |