[carton] 62/472: added check test

[Lucas Kanashiro]

This is an automated email from the git hooks/post-receive script.

kanashiro-guest pushed a commit to branch master
in repository carton.

commit e6273cf74d19dcb0cc2517b1aa67f9a9a74a2dfd
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Mon Jun 27 10:05:31 2011 -0400

    added check test
---
 lib/Carton.pm  |  9 +++++++--
 xt/CLI.pm      | 32 ++++++++++++++++++++++++++++++--
 xt/cli/check.t | 31 +++++++++++++++++++++++++++++++
 3 files changed, 68 insertions(+), 4 deletions(-)

diff --git a/lib/Carton.pm b/lib/Carton.pm
index 67dd933..d40ecbb 100644
--- a/lib/Carton.pm
+++ b/lib/Carton.pm
@@ -284,13 +284,16 @@ sub find_locals {
 
     require File::Find;
 
+    my $libdir = "$self->{path}/lib/perl5/auto/meta";
+    return unless -e $libdir;
+
     my @locals;
     my $wanted = sub {
         if ($_ eq 'local.json') {
             push @locals, $File::Find::name;
         }
     };
-    File::Find::find($wanted, "$self->{path}/lib/perl5/auto/meta");
+    File::Find::find($wanted, $libdir);
 
     return map { my $module = Carton::Util::parse_json($_); ($module->{name} => $module) } @locals;
 }
@@ -311,9 +314,11 @@ sub check_satisfies {
         $self->_check_satisfies($dep, \@unsatisfied, $index, \%pool);
     }
 
+    my $tree = keys %pool ? $self->build_tree(\%pool) : undef;
+
     return {
         unsatisfied => \@unsatisfied,
-        superflous  => $self->build_tree(\%pool),
+        superflous  => $tree,
     };
 }
 
diff --git a/xt/CLI.pm b/xt/CLI.pm
index a1dcf5f..1e0ea11 100644
--- a/xt/CLI.pm
+++ b/xt/CLI.pm
@@ -1,10 +1,18 @@
 package xt::CLI;
 use strict;
 use base qw(Exporter);
-our @EXPORT = qw(run);
+our @EXPORT = qw(run cli);
+
+use Test::Requires qw( Directory::Scratch );
+
+sub cli {
+    my $dir = Directory::Scratch->new();
+    chdir $dir;
+    return Carton::CLI::Tested->new(dir => $dir);
+}
 
 sub run {
-    my $app = Carton::CLI::Tested->new;
+    my $app = cli();
     $app->run(@_);
     return $app;
 }
@@ -12,11 +20,31 @@ sub run {
 package Carton::CLI::Tested;
 use parent qw(Carton::CLI);
 
+sub new {
+    my($class, %args) = @_;
+
+    my $self = $class->SUPER::new;
+    $self->{dir} = $args{dir};
+
+    return $self;
+}
+
+sub dir {
+    my $self = shift;
+    $self->{dir};
+}
+
 sub print {
     my $self = shift;
     $self->{output} .= $_[0];
 }
 
+sub run {
+    my $self = shift;
+    $self->{output} = '';
+    $self->SUPER::run(@_);
+}
+
 sub output {
     my $self = shift;
     $self->{output};
diff --git a/xt/cli/check.t b/xt/cli/check.t
new file mode 100644
index 0000000..59cdd21
--- /dev/null
+++ b/xt/cli/check.t
@@ -0,0 +1,31 @@
+use strict;
+use Test::More;
+use xt::CLI;
+
+{
+    my $app = cli();
+
+    $app->dir->touch("Makefile.PL", <<EOF);
+use ExtUtils::MakeMaker;
+WriteMakefile(
+  NAME => "foo",
+  VERSION => 1,
+  PREREQ_PM => {
+    "Try::Tiny" => 0,
+  },
+);
+EOF
+
+    $app->run("check");
+    like $app->output, qr/Following dependencies are not satisfied.*Try::Tiny/s;
+    unlike $app->output, qr/found in local but/;
+
+    $app->run("install");
+    $app->run("check");
+
+    like $app->output, qr/matches/;
+}
+
+
+done_testing;
+

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/carton.git