Improve handling of broken versions in Module::CoreList::is_core

- Only parse the user-provided version once
- Include the invalid version in the error message
- Ignore broken versions in M:CL's own data

diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes
index 4e173c6..951e10d 100644 (file)
--- a/dist/Module-CoreList/Changes
+++ b/dist/Module-CoreList/Changes
@@ -1,3 +1,6 @@
+5.20180222
+  - Improve handling of broken versions in is_core()
+
 5.20180220
   - Updated for v5.27.9
 

diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm
index 5178b28..e745159 100644 (file)
--- a/dist/Module-CoreList/lib/Module/CoreList.pm
+++ b/dist/Module-CoreList/lib/Module/CoreList.pm
@@ -4,7 +4,7 @@ use strict;
 our ( %released, %version, %families, %upstream, %bug_tracker, %deprecated, %delta );
 
 use version;
-our $VERSION = '5.20180220';
+our $VERSION = '5.20180222';
 
 sub PKG_PATTERN () { q#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z# }
 sub _looks_like_invocant ($) { local $@; !!eval { $_[0]->isa(__PACKAGE__) } }
@@ -15051,6 +15051,11 @@ sub is_core
     # On the way if we pass the required module version, we can
     # short-circuit and return true
     if (defined($module_version)) {
+        my $module_version_object = eval { version->parse($module_version) };
+        if (!defined($module_version_object)) {
+            (my $err = $@) =~ s/^Invalid version format\b/Invalid version '$module_version' specified/;
+            die $err;
+        }
         # The Perl releases aren't a linear sequence, but a tree. We need to build the path
         # of releases from 5 to the specified release, and follow the module's version(s)
         # along that path.
@@ -15068,7 +15073,7 @@ sub is_core
             last RELEASE if $prn > $perl_version;
             next unless defined(my $next_module_version
                                    = $delta{$prn}->{changed}->{$module});
-            return 1 if version->parse($next_module_version) >= version->parse($module_version);
+            return 1 if eval { version->parse($next_module_version) >= $module_version_object };
         }
         return 0;
     }

diff --git a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm
index 3c4541a..857894a 100644 (file)
--- a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm
+++ b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm
@@ -1,7 +1,7 @@
 # For internal Module::CoreList use only.
 package Module::CoreList::TieHashDelta;
 use strict;
-our $VERSION = '5.20180220';
+our $VERSION = '5.20180222';
 
 sub TIEHASH {
     my ($class, $changed, $removed, $parent) = @_;

diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm
index fe4c6d9..90e506d 100644 (file)
--- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm
+++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use Module::CoreList;
 
-our $VERSION = '5.20180220';
+our $VERSION = '5.20180222';
 our %utilities;
 
 sub utilities {

diff --git a/dist/Module-CoreList/t/is_core.t b/dist/Module-CoreList/t/is_core.t
index 3903703..70f13a8 100644 (file)
--- a/dist/Module-CoreList/t/is_core.t
+++ b/dist/Module-CoreList/t/is_core.t
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use Module::CoreList;
-use Test::More tests => 43;
+use Test::More tests => 44;
 
 BEGIN { require_ok('Module::CoreList'); }
 
@@ -82,3 +82,6 @@ ok(! Module::CoreList->is_core("CGI", undef, 5.021001), "CGI not in 5.021001");
 
 ok(  Module::CoreList::is_core("Config", 0, "5.020"), "Config v0+ is in core in 5.020");
 ok(  Module::CoreList::is_core("Config", undef, "5.020"), "Config v(undef) is in core in 5.020");
+
+eval { Module::CoreList::is_core('Config', 'invalid', '5.020'); };
+like( $@, qr/^Invalid version 'invalid' specified\b/, 'invalid version throws');