Merge pull request #446 from miyagawa/cpanfile-pinning

Honor cpanfile requirements when recursing sub dependencies

lib/App/cpanminus/Dependency.pm

@@ -3,16 +3,14 @@ use strict;
 use CPAN::Meta::Requirements;
 
 sub from_prereqs {
-    my($class, $prereq, $phases, $types) = @_;
+    my($class, $prereqs, $phases, $types) = @_;
 
     my @deps;
-
     for my $type (@$types) {
-        my $req = CPAN::Meta::Requirements->new;
-        $req->add_requirements($prereq->requirements_for($_, $type))
-          for @$phases;
-
-        push @deps, $class->from_versions($req->as_string_hash, $type);
+        push @deps, $class->from_versions(
+            $prereqs->merged_requirements($phases, [$type])->as_string_hash,
+            $type,
+        );
     }
 
     return @deps;
@@ -29,6 +27,14 @@ sub from_versions {
     @deps;
 }
 
+sub merge_with {
+    my($self, $requirements) = @_;
+
+    # should it clone? not cloning means we upgrade root $requirements on our way
+    $requirements->add_string_requirement($self->module, $self->version);
+    $self->{version} = $requirements->requirements_for_module($self->module);
+}
+
 sub new {
     my($class, $module, $version, $type) = @_;
 

lib/App/cpanminus/script.pm

@@ -2534,6 +2534,12 @@ sub find_prereqs {
         push @deps, $self->bundle_deps($dist);
     }
 
+    if ($self->{cpanfile_requirements} && !$dist->{cpanfile}) {
+        for my $dep (@deps) {
+            $dep->merge_with($self->{cpanfile_requirements});
+        }
+    }
+
     return @deps;
 }
 
@@ -2543,6 +2549,8 @@ sub extract_meta_prereqs {
     if ($dist->{cpanfile}) {
         my @features = $self->configure_features($dist, $dist->{cpanfile}->features);
         my $prereqs = $dist->{cpanfile}->prereqs_with(@features);
+        # TODO: creating requirements is useful even without cpanfile to detect conflicting prereqs
+        $self->{cpanfile_requirements} = $prereqs->merged_requirements($dist->{want_phases}, ['requires']);
         return App::cpanminus::Dependency->from_prereqs($prereqs, $dist->{want_phases}, $self->{install_types});
     }
 

testdist/cpanfile_app2/cpanfile.foobar

@@ -1 +1 @@
-requires 'Hash::MultiValue', '== 0.10';
+requires 'Hash::MultiValue', '== 0.12';

testdist/cpanfile_pin/cpanfile

@@ -0,0 +1,5 @@
+requires 'Module::Refresh', '== 0.17';
+requires 'Path::Class', '== 0.26';
+
+requires 'Data::Dumper', '== 2.139';
+requires 'Test::Differences', '== 0.61';

xt/cpanfile.t

@@ -19,7 +19,7 @@ use xt::Run;
 
 {
     run "--installdeps", "--notest", "--cpanfile", "cpanfile.foobar", "./testdist/cpanfile_app2";
-    like last_build_log, qr/installed Hash-MultiValue-0\.10/;
+    like last_build_log, qr/installed Hash-MultiValue-0\.12/;
 }
 
 done_testing;

xt/cpanfile_pin.t

@@ -0,0 +1,13 @@
+use strict;
+use Test::More;
+use xt::Run;
+
+{
+    run_L "--installdeps", "--notest", "./testdist/cpanfile_pin";
+    unlike last_build_log, qr/Installed version \(.*\) of Path::Class is not in range '== 0.26'/;
+
+    like last_build_log, qr/installed Path-Class-0\.26/;
+    like last_build_log, qr/installed Data-Dumper-2\.139/;
+}
+
+done_testing;