Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

[App::Pls] implemented 'install'

All t/subcommands/install-*.t tests pass. Which means that all tests now pass.
  • Loading branch information...
commit 0358c5ba39a822f93da16904773f8ef96be20b92 1 parent 07dcc69
Carl Mäsak authored June 13, 2010
43  lib/App/Pls.pm
@@ -58,6 +58,7 @@ role App::Pls::Tester {
58 58
 }
59 59
 
60 60
 role App::Pls::Installer {
  61
+    method install($project) { !!! }
61 62
 }
62 63
 
63 64
 class App::Pls::Core {
@@ -65,6 +66,7 @@ class App::Pls::Core {
65 66
     has App::Pls::Fetcher       $!fetcher;
66 67
     has App::Pls::Builder       $!builder;
67 68
     has App::Pls::Tester        $!tester;
  69
+    has App::Pls::Installer     $!installer;
68 70
 
69 71
     method state-of($project) {
70 72
         return $!projects.state-of($project);
@@ -162,6 +164,45 @@ class App::Pls::Core {
162 164
     }
163 165
 
164 166
     method install(*@projects, Bool :$force, Bool :$skip-test) {
165  
-        return;
  167
+        my $*needed-force = False;
  168
+        for @projects -> $project {
  169
+            my %*seen-projects;
  170
+            return failure
  171
+                if self!fetch-helper($project) == failure;
  172
+            return failure
  173
+                if self!build-helper($project) == failure;
  174
+            unless $skip-test {
  175
+                if self!test-helper($project) == failure {
  176
+                    return failure
  177
+                        unless $force;
  178
+                    $*needed-force = True;
  179
+                }
  180
+            }
  181
+            # RAKUDO: an unspecified $force should be False, is Any
  182
+            return failure
  183
+                if self!install-helper($project, :force(?$force)) == failure;
  184
+        }
  185
+        return $*needed-force ?? forced-success !! success;
  186
+    }
  187
+
  188
+    method !install-helper($project, Bool :$force --> Result) {
  189
+        for $!projects.deps-of($project) -> $dep {
  190
+            # RAKUDO: an unspecified $force should be False, is Any
  191
+            if self!install-helper($dep, :force(?$force)) == failure {
  192
+                return failure
  193
+                    unless $force;
  194
+                $*needed-force = True;
  195
+            }
  196
+        }
  197
+        if $!projects.reached-state($project, 'installed') {
  198
+            return success;
  199
+        }
  200
+        elsif $!installer.install($project) == success {
  201
+            $!projects.set-state-of($project, 'installed');
  202
+            return success;
  203
+        }
  204
+        else {
  205
+            return failure;
  206
+        }
166 207
     }
167 208
 }
30  t/subcommands/install-skip-tests.t
@@ -32,15 +32,39 @@ my %projects =
32 32
 my @actions;
33 33
 
34 34
 class Mock::Fetcher does App::Pls::Fetcher {
  35
+    method fetch($project) {
  36
+        push @actions, "fetch[$project]";
  37
+        return failure
  38
+            if $project eq "won't-fetch";
  39
+        return success;
  40
+    }
35 41
 }
36 42
 
37 43
 class Mock::Builder does App::Pls::Builder {
  44
+    method build($project) {
  45
+        push @actions, "build[$project]";
  46
+        return failure
  47
+            if $project ~~ /^ won\'t\-build/;
  48
+        return success;
  49
+    }
38 50
 }
39 51
 
40 52
 class Mock::Tester does App::Pls::Tester {
  53
+    method test($project) {
  54
+        push @actions, "test[$project]";
  55
+        return failure
  56
+            if $project ~~ /^ won\'t\-test/;
  57
+        return success;
  58
+    }
41 59
 }
42 60
 
43 61
 class Mock::Installer does App::Pls::Installer {
  62
+    method install($project) {
  63
+        push @actions, "install[$project]";
  64
+        return failure
  65
+            if $project eq "won't-install";
  66
+        return success;
  67
+    }
44 68
 }
45 69
 
46 70
 my $core = App::Pls::Core.new(
@@ -63,7 +87,7 @@ given $core {
63 87
     is .install(<won't-test>, :skip-test), success, #'
64 88
         "Tests are never run, go directly to install";
65 89
     is ~@actions, "install[won't-test]", "Tests skipped, installed";
66  
-    is .state-of("won't test"), 'installed', "State after: 'installed'";
  90
+    is .state-of("won't-test"), 'installed', "State after: 'installed'";
67 91
 
68 92
     # [T] Install-ST an unbuilt project: Build, don't test, install.
69 93
     @actions = ();
@@ -119,8 +143,8 @@ given $core {
119 143
     is .install(<circ-deps>, :skip-test), failure,
120 144
         "Circular dependency install: fail";
121 145
     is ~@actions, '', "Nothing was done";
122  
-    is .state-of("circ-deps"), 'tested', "State after of circ-deps: unchanged";
123  
-    is .state-of("E"), 'tested', "State after of E: unchanged";
  146
+    is .state-of("circ-deps"), 'built', "State after of circ-deps: unchanged";
  147
+    is .state-of("E"), 'built', "State after of E: unchanged";
124 148
 
125 149
     # [T] Install-ST a project whose direct dependency fails: Fail.
126 150
     @actions = ();
29  t/subcommands/install-with-force.t
@@ -18,6 +18,7 @@ my %projects =
18 18
     "circ-deps"     => { :state<tested>, :deps<E> },
19 19
     E               => { :state<tested>, :deps<circ-deps> },
20 20
     "dirdep-fails"  => { :state<tested>, :deps<won't-install> }, #'
  21
+    "won't-install" => { :state<tested> },
21 22
     "indir-fails"   => { :state<tested>, :deps<F> },
22 23
     F               => { :state<tested>, :deps<won't-install G H> }, #'
23 24
     G               => { :state<tested> },
@@ -27,15 +28,39 @@ my %projects =
27 28
 my @actions;
28 29
 
29 30
 class Mock::Fetcher does App::Pls::Fetcher {
  31
+    method fetch($project) {
  32
+        push @actions, "fetch[$project]";
  33
+        return failure
  34
+            if $project eq "won't-fetch";
  35
+        return success;
  36
+    }
30 37
 }
31 38
 
32 39
 class Mock::Builder does App::Pls::Builder {
  40
+    method build($project) {
  41
+        push @actions, "build[$project]";
  42
+        return failure
  43
+            if $project ~~ /^ won\'t\-build/;
  44
+        return success;
  45
+    }
33 46
 }
34 47
 
35 48
 class Mock::Tester does App::Pls::Tester {
  49
+    method test($project) {
  50
+        push @actions, "test[$project]";
  51
+        return failure
  52
+            if $project ~~ /^ won\'t\-test/;
  53
+        return success;
  54
+    }
36 55
 }
37 56
 
38 57
 class Mock::Installer does App::Pls::Installer {
  58
+    method install($project) {
  59
+        push @actions, "install[$project]";
  60
+        return failure
  61
+            if $project eq "won't-install";
  62
+        return success;
  63
+    }
39 64
 }
40 65
 
41 66
 my $core = App::Pls::Core.new(
@@ -54,7 +79,7 @@ given $core {
54 79
     is .install(<won't-test>, :force), forced-success, #'
55 80
         "Testing fails, install anyway";
56 81
     is ~@actions, "test[won't-test] install[won't-test]", "Tested, installed";
57  
-    is .state-of("won't test"), 'installed', "State after: 'installed'";
  82
+    is .state-of("won't-test"), 'installed', "State after: 'installed'";
58 83
 
59 84
     # [T] Force install an unbuilt project; build fails. Fail.
60 85
     @actions = ();
@@ -94,7 +119,7 @@ given $core {
94 119
     is ~@actions, "fetch[won't-test-3] build[won't-test-3] test[won't-test-3] "
95 120
                   ~ "install[won't-test-3]",
96 121
         "Fetch, build, test and install";
97  
-    is .state-of("won't-test-3"), 'built', "State after: 'built'";
  122
+    is .state-of("won't-test-3"), 'installed', "State after: 'installed'";
98 123
 
99 124
     # [T] Force install a project with dependencies: Install dependencies too.
100 125
     @actions = ();
28  t/subcommands/install-with-test.t
@@ -29,15 +29,39 @@ my %projects =
29 29
 my @actions;
30 30
 
31 31
 class Mock::Fetcher does App::Pls::Fetcher {
  32
+    method fetch($project) {
  33
+        push @actions, "fetch[$project]";
  34
+        return failure
  35
+            if $project eq "won't-fetch";
  36
+        return success;
  37
+    }
32 38
 }
33 39
 
34 40
 class Mock::Builder does App::Pls::Builder {
  41
+    method build($project) {
  42
+        push @actions, "build[$project]";
  43
+        return failure
  44
+            if $project ~~ /^ won\'t\-build/;
  45
+        return success;
  46
+    }
35 47
 }
36 48
 
37 49
 class Mock::Tester does App::Pls::Tester {
  50
+    method test($project) {
  51
+        push @actions, "test[$project]";
  52
+        return failure
  53
+            if $project ~~ /^ won\'t\-test/;
  54
+        return success;
  55
+    }
38 56
 }
39 57
 
40 58
 class Mock::Installer does App::Pls::Installer {
  59
+    method install($project) {
  60
+        push @actions, "install[$project]";
  61
+        return failure
  62
+            if $project eq "won't-install";
  63
+        return success;
  64
+    }
41 65
 }
42 66
 
43 67
 my $core = App::Pls::Core.new(
@@ -72,7 +96,7 @@ given $core {
72 96
     @actions = ();
73 97
     is .install(<won't-test>), failure, "Testing fails, won't install"; #"
74 98
     is ~@actions, "test[won't-test]", "Tested, didn't install";
75  
-    is .state-of("won't test"), 'built', "State after: unchanged";
  99
+    is .state-of("won't-test"), 'built', "State after: unchanged";
76 100
 
77 101
     # [T] Install an unbuilt project: Build, test, install.
78 102
     @actions = ();
@@ -98,7 +122,7 @@ given $core {
98 122
     @actions = ();
99 123
     is .install(<unfetched>), success, "Fetch, build, test, install";
100 124
     is ~@actions,
101  
-        'fetch[unfetched] build[unfetched] test[unfetched] install[unfected]',
  125
+        'fetch[unfetched] build[unfetched] test[unfetched] install[unfetched]',
102 126
         "Correct order";
103 127
     is .state-of("unfetched"), 'installed', "State after: 'installed'";
104 128
 

0 notes on commit 0358c5b

Please sign in to comment.
Something went wrong with that request. Please try again.