[carton] 61/472: beginning unit tests

[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 9afb11e98411355897cf25376b841a8db73d2f31
Author: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
Date:   Mon Jun 27 09:44:01 2011 -0400

    beginning unit tests
---
 Makefile.PL       |  1 +
 lib/Carton/CLI.pm | 13 +++++++------
 xt/CLI.pm         | 26 ++++++++++++++++++++++++++
 xt/cli/version.t  |  9 +++++++++
 4 files changed, 43 insertions(+), 6 deletions(-)

diff --git a/Makefile.PL b/Makefile.PL
index 5175153..b88e1d2 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -12,6 +12,7 @@ requires 'App::cpanminus', 1.4900;
 requires 'Term::ANSIColor', 1.12;
 requires 'Module::Metadata', 1.000003;
 requires 'Try::Tiny';
+requires 'parent';
 
 install_script 'bin/carton';
 
diff --git a/lib/Carton/CLI.pm b/lib/Carton/CLI.pm
index 6038522..1e554df 100644
--- a/lib/Carton/CLI.pm
+++ b/lib/Carton/CLI.pm
@@ -79,7 +79,7 @@ sub commands {
 
 sub cmd_usage {
     my $self = shift;
-    print <<HELP;
+    $self->print(<<HELP);
 Usage: carton <command>
 
 where <command> is one of:
@@ -113,7 +113,8 @@ sub cmd_help {
 }
 
 sub cmd_version {
-    print "carton $Carton::VERSION\n";
+    my $self = shift;
+    $self->print("carton $Carton::VERSION\n");
 }
 
 sub cmd_install {
@@ -178,8 +179,8 @@ sub cmd_show {
         my $tree = $self->carton->build_tree($lock->{modules});
         $self->carton->walk_down_tree($tree, sub {
             my($module, $depth) = @_;
-            print "  " x $depth;
-            print "$module->{dist}\n";
+            my $line = " " x $depth . "$module->{dist}\n";
+            $self->print($line);
         });
     } else {
         for my $module (values %{$lock->{modules} || {}}) {
@@ -217,8 +218,8 @@ sub cmd_check {
         $self->print("Following modules are found in $self->{path} but couldn't be tracked from your $file\n", WARN);
         $self->carton->walk_down_tree($res->{superflous}, sub {
             my($module, $depth) = @_;
-            print "  " x $depth;
-            print "$module->{dist}\n";
+            my $line = "  " x $depth . "$module->{dist}\n";
+            $self->print($line);
         }, 1);
         $ok = 0;
     }
diff --git a/xt/CLI.pm b/xt/CLI.pm
new file mode 100644
index 0000000..a1dcf5f
--- /dev/null
+++ b/xt/CLI.pm
@@ -0,0 +1,26 @@
+package xt::CLI;
+use strict;
+use base qw(Exporter);
+our @EXPORT = qw(run);
+
+sub run {
+    my $app = Carton::CLI::Tested->new;
+    $app->run(@_);
+    return $app;
+}
+
+package Carton::CLI::Tested;
+use parent qw(Carton::CLI);
+
+sub print {
+    my $self = shift;
+    $self->{output} .= $_[0];
+}
+
+sub output {
+    my $self = shift;
+    $self->{output};
+}
+
+1;
+
diff --git a/xt/cli/version.t b/xt/cli/version.t
new file mode 100644
index 0000000..5ee107b
--- /dev/null
+++ b/xt/cli/version.t
@@ -0,0 +1,9 @@
+use strict;
+use Test::More;
+
+use xt::CLI;
+
+like run("version")->output, qr/carton $Carton::VERSION/;
+
+done_testing;
+

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