[PATCH] Fixed bug where is_core assumed linear release sequence

If you specified a version of the module, is_core has to track through
releases, as the %delta data structure only records where a module
version number changes in core, not every module version number in every release.
I was naively trawling the releases in numerical order, but %delta includes
information that let's you construct the release tree.

This fix only traverses the branch of the overall release tree that leads
to the specified Perl release. Further explanation and example in blog post:

    http://neilb.org/2013/09/21/adding-is-core.html

Signed-off-by: Chris 'BinGOs' Williams <chris@bingosnet.co.uk>

diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes
index ff87f1b..66742c7 100644 (file)
--- a/dist/Module-CoreList/Changes
+++ b/dist/Module-CoreList/Changes
@@ -1,6 +1,8 @@
 3.00
   - Prepared for v5.19.5
   - exported %delta
+  - fixed bug in is_core(): it was naively assuming a linear sequence of releases,
+    rather than the tree with multiple branches.
 
 2.99 Fri Sep 20 2013
   - Updated for v5.19.4

diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm
index e316afc..1ec4350 100644 (file)
--- a/dist/Module-CoreList/lib/Module/CoreList.pm
+++ b/dist/Module-CoreList/lib/Module/CoreList.pm
@@ -8842,14 +8842,23 @@ sub is_core
     return 0 if defined($final_release) && $perl_version > $final_release;
 
     # If a minimum version of the module was specified:
-    # Step through all perl release numbers ($prn)
-    # in order, so we can find what version of the module
+    # Step through all perl releases ($prn)
+    # so we can find what version of the module
     # was included in the specified version of perl.
     # On the way if we pass the required module version, we can
     # short-circuit and return true
     if (defined($module_version)) {
+        # 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.
+        my @releases = ($perl_version);
+        my $rel = $perl_version;
+        while (defined($rel)) {
+            $rel = $delta{$rel}->{delta_from};
+            unshift(@releases, $rel) if defined($rel);
+        }
         RELEASE:
-        foreach my $prn (sort keys %delta) {
+        foreach my $prn (@releases) {
             next RELEASE if $prn <= $first_release;
             last RELEASE if $prn > $perl_version;
             next unless defined(my $next_module_version

diff --git a/dist/Module-CoreList/t/is_core.t b/dist/Module-CoreList/t/is_core.t
index a145315..712221f 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 => 23;
+use Test::More tests => 33;
 
 BEGIN { require_ok('Module::CoreList'); }
 
@@ -50,3 +50,18 @@ ok(Module::CoreList->is_core('encoding', '2.01', '5.008007'), "encoding 2.01 was
 ok(!Module::CoreList::is_core('Module::CoreList', undef, '5.007003'), "Module::CoreList wasn't core in perl 5.7.3");
 ok(!Module::CoreList->is_core('Module::CoreList', undef, '5.007003'), "Module::CoreList wasn't core in perl 5.7.3 (class method)");
 
+# Test for situations where different branches on the perl
+# release tree had different versions of a module, and a naive
+# checking of perl release number will trip you up
+ok(Module::CoreList->is_core('Text::Soundex', '1.01', '5.008007'), "Text::Soundex 1.01 was first included in 5.007003");
+ok(Module::CoreList->is_core('Text::Soundex', '3.03', '5.008009'), "Text::Soundex 3.03 was included in 5.008009");
+ok(!Module::CoreList->is_core('Text::Soundex', '3.03', '5.009003'), "5.009003 still had Text::Soundex 1.01");
+ok(Module::CoreList->is_core('Text::Soundex', '1.01', '5.009003'), "5.009003 still had Text::Soundex 1.01");
+ok(!Module::CoreList->is_core('Text::Soundex', '3.03', '5.009005'), "5.009005 still had Text::Soundex 3.02");
+ok(Module::CoreList->is_core('Text::Soundex', '3.02', '5.009005'), "5.009005 had Text::Soundex 3.02");
+ok(Module::CoreList->is_core('Text::Soundex', '3.03', '5.01'), "5.01 had Text::Soundex 3.03");
+
+# 5.002 was the first perl release where core modules had a version number
+ok(Module::CoreList->is_core('DB_File', '1.01', '5.002'), "DB_File 1.01 was included in 5.002");
+ok(!Module::CoreList->is_core('DB_File', '1.03', '5.002'), "DB_File 1.03 wasn't included in 5.002");
+ok(Module::CoreList->is_core('DB_File', '1.03', '5.00307'), "DB_File 1.03 was included in 5.00307");