This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use correct err msg in XS version check
authorFather Chrysostomos <sprout@cpan.org>
Wed, 23 Nov 2011 20:47:50 +0000 (12:47 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 24 Nov 2011 09:45:28 +0000 (01:45 -0800)
When an XS module’s version is checked when it is loading, the string
"version" should be treated the same way as "versions" and emit the
‘Invalid version format’ error, instead of being treated as a version
object at first and then rejected by the validator with the ‘Invalid
version object’ error.

See also perl #102586.

dist/XSLoader/t/XSLoader.t
util.c

index 164e4e5..20ca32b 100644 (file)
@@ -33,7 +33,7 @@ my %modules = (
     'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep'  ) |,  # 5.7.3
 );
 
-plan tests => keys(%modules) * 3 + 7;
+plan tests => keys(%modules) * 3 + 8;
 
 # Try to load the module
 use_ok( 'XSLoader' );
@@ -89,3 +89,10 @@ for my $module (sort keys %modules) {
     }
 }
 
+SKIP: {
+    skip "Needs 5.15.6", 1 unless $] > 5.0150051;
+    skip "List::Util not available", 1 if $extensions !~ /\bList::Util\b/;
+    eval 'package List::Util; XSLoader::load(__PACKAGE__, "version")';
+    like $@, "/^Invalid version format/",
+        'correct error msg for invalid versions';
+}
diff --git a/util.c b/util.c
index 4a170aa..052cb2c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -6430,7 +6430,7 @@ Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
     }
     if (sv) {
        SV *xssv = Perl_newSVpvn_flags(aTHX_ xs_p, xs_len, SVs_TEMP);
-       SV *pmsv = sv_derived_from(sv, "version")
+       SV *pmsv = sv_derived_from(sv, "version") && SvROK(sv)
            ? sv : sv_2mortal(new_version(sv));
        xssv = upg_version(xssv, 0);
        if ( vcmp(pmsv,xssv) ) {