From 07dcc69a90f61c5e2cac005e74721c07a86d81c1 Mon Sep 17 00:00:00 2001
From: Carl Masak <cmasak@gmail.com>
Date: Sun, 13 Jun 2010 17:15:16 +0200
Subject: [PATCH] [App::Pls] implemented 'test'

All t/subcommands/test.t tests now pass.
---
 lib/App/Pls.pm       | 34 +++++++++++++++++++++++++++++++++-
 t/subcommands/test.t | 22 ++++++++++++++++++----
 2 files changed, 51 insertions(+), 5 deletions(-)

diff --git a/lib/App/Pls.pm b/lib/App/Pls.pm
index 2e0892b..8b7c6b9 100644
--- a/lib/App/Pls.pm
+++ b/lib/App/Pls.pm
@@ -54,6 +54,7 @@ role App::Pls::Builder {
 }
 
 role App::Pls::Tester {
+    method test($project) { !!! }
 }
 
 role App::Pls::Installer {
@@ -63,6 +64,7 @@ class App::Pls::Core {
     has App::Pls::ProjectsState $!projects;
     has App::Pls::Fetcher       $!fetcher;
     has App::Pls::Builder       $!builder;
+    has App::Pls::Tester        $!tester;
 
     method state-of($project) {
         return $!projects.state-of($project);
@@ -126,7 +128,37 @@ class App::Pls::Core {
     }
 
     method test(*@projects, Bool :$ignore-deps) {
-        return;
+        for @projects -> $project {
+            my %*seen-projects;
+            return failure
+                if self!fetch-helper($project) == failure;
+            return failure
+                if self!build-helper($project) == failure;
+            # RAKUDO: an unspecified $ignore-deps should be False, is Any
+            return failure
+                if self!test-helper($project, :ignore-deps(?$ignore-deps))
+                    == failure;
+        }
+        return success;
+    }
+
+    method !test-helper($project, Bool :$ignore-deps --> Result) {
+        unless $ignore-deps {
+            for $!projects.deps-of($project) -> $dep {
+                return failure
+                    if self!test-helper($dep) == failure;
+            }
+        }
+        if $!projects.reached-state($project, 'tested') {
+            return success;
+        }
+        elsif $!tester.test($project) == success {
+            $!projects.set-state-of($project, 'tested');
+            return success;
+        }
+        else {
+            return failure;
+        }
     }
 
     method install(*@projects, Bool :$force, Bool :$skip-test) {
diff --git a/t/subcommands/test.t b/t/subcommands/test.t
index c8cd5be..8bd7581 100644
--- a/t/subcommands/test.t
+++ b/t/subcommands/test.t
@@ -26,12 +26,24 @@ my %projects =
 my @actions;
 
 class Mock::Fetcher does App::Pls::Fetcher {
+    method fetch($project) {
+        push @actions, "fetch[$project]";
+        $project eq "won't-fetch" ?? failure !! success;
+    }
 }
 
 class Mock::Builder does App::Pls::Builder {
+    method build($project) {
+        push @actions, "build[$project]";
+        $project ~~ /^won\'t\-build/ ?? failure !! success;
+    }
 }
 
 class Mock::Tester does App::Pls::Tester {
+    method test($project) {
+        push @actions, "test[$project]";
+        $project eq "won't-test" ?? failure !! success;
+    }
 }
 
 my $core = App::Pls::Core.new(
@@ -70,6 +82,7 @@ given $core {
     is .state-of("unfetched"), 'tested', "State after: 'tested'";
 
     # [T] Test an unfetched project; fetch fails. Fail.
+    @actions = ();
     is .test(<won't-fetch>), failure, "Won't fetch and thus won't test"; #'
     is ~@actions, "fetch[won't-fetch]",
         "Tried fetching, not building or testing";
@@ -90,7 +103,7 @@ given $core {
     @actions = ();
     is .test(<has-deps>), success, "Test a project with dependencies";
     is ~@actions,
-        'fetch[C] build[D] build[B] '
+        'fetch[C] build[C] build[D] build[B] '
         ~ 'test[A] test[C] test[D] test[B] test[has-deps]',
         "Fetch first, then build (postorder), then test (postorder)";
     is .state-of("has-deps"), 'tested', "State after of has-deps: 'tested'";
@@ -102,9 +115,10 @@ given $core {
     #     dependencies: test only the project, do not fetch/build dependencies
     @actions = ();
     is .test(<ignore-deps>, :ignore-deps), success, "Test-ignore-deps works";
-    is ~@actions, 'test[ignore-deps]', "Only ignore-deps is tested";
+    is ~@actions, 'fetch[E] build[E] build[F] test[ignore-deps]',
+        "Only ignore-deps is tested";
     is .state-of("ignore-deps"), 'tested', "State after: 'tested'";
-    is .state-of("E"), 'gone', "State after of E: unchanged";
-    is .state-of("F"), 'fetched', "State after of F: unchanged";
+    is .state-of("E"), 'built', "State after of E: 'built'";
+    is .state-of("F"), 'built', "State after of F: 'built'";
     is .state-of("G"), 'built', "State after of G: unchanged";
 }