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 'build'

All t/subcommands/build.t tests now pass.
  • Loading branch information...
commit d952250d9a34d966426cb870a53812629b111885 1 parent 44c586b
Carl Mäsak authored June 13, 2010
44  lib/App/Pls.pm
... ...
@@ -1,14 +1,15 @@
1 1
 use v6;
2 2
 
3  
-subset State of Str where {
  3
+subset State of Str where
4 4
     'gone' | 'fetched' | 'built' | 'tested' | 'installed'
5  
-};
  5
+;
6 6
 enum Result <failure success forced-success>;
7 7
 
8 8
 role App::Pls::ProjectsState {
9 9
     method state-of($project --> State) { !!! }
10 10
     method set-state-of($project, State $state) { !!! }
11 11
     method deps-of($project) { !!! }
  12
+    method reached-state($project, State $state --> Bool) { !!! }
12 13
 }
13 14
 
14 15
 class App::Pls::ProjectsState::Hash does App::Pls::ProjectsState {
@@ -35,6 +36,13 @@ class App::Pls::ProjectsState::Hash does App::Pls::ProjectsState {
35 36
         }
36 37
         die "No such project: $project";
37 38
     }
  39
+
  40
+    method reached-state($project, $goal-state --> Bool) {
  41
+        my $actual-state = self.state-of($project);
  42
+        my @states = <gone fetched built tested installed>;
  43
+        my %state-levels = invert @states;
  44
+        return %state-levels{$actual-state} >= %state-levels{$goal-state};
  45
+    }
38 46
 }
39 47
 
40 48
 role App::Pls::Fetcher {
@@ -42,6 +50,7 @@ role App::Pls::Fetcher {
42 50
 }
43 51
 
44 52
 role App::Pls::Builder {
  53
+    method build($project) { !!! }
45 54
 }
46 55
 
47 56
 role App::Pls::Tester {
@@ -76,7 +85,10 @@ class App::Pls::Core {
76 85
             return failure
77 86
                 if self!fetch-helper($dep) == failure;
78 87
         }
79  
-        if $!fetcher.fetch($project) == success {
  88
+        if $!projects.reached-state($project, 'fetched') {
  89
+            return success;
  90
+        }
  91
+        elsif $!fetcher.fetch($project) == success {
80 92
             $!projects.set-state-of($project, 'fetched');
81 93
             return success;
82 94
         }
@@ -86,7 +98,31 @@ class App::Pls::Core {
86 98
     }
87 99
 
88 100
     method build(*@projects) {
89  
-        return;
  101
+        for @projects -> $project {
  102
+            my %*seen-projects;
  103
+            return failure
  104
+                if self!fetch-helper($project) == failure;
  105
+            return failure
  106
+                if self!build-helper($project) == failure;
  107
+        }
  108
+        return success;
  109
+    }
  110
+
  111
+    method !build-helper($project --> Result) {
  112
+        for $!projects.deps-of($project) -> $dep {
  113
+            return failure
  114
+                if self!build-helper($dep) == failure;
  115
+        }
  116
+        if $!projects.reached-state($project, 'built') {
  117
+            return success;
  118
+        }
  119
+        elsif $!builder.build($project) == success {
  120
+            $!projects.set-state-of($project, 'built');
  121
+            return success;
  122
+        }
  123
+        else {
  124
+            return failure;
  125
+        }
90 126
     }
91 127
 
92 128
     method test(*@projects, Bool :$ignore-deps) {
36  t/subcommands/build.t
@@ -7,25 +7,33 @@ my %projects =
7 7
     fetched       => { :state<fetched> },
8 8
     unfetched     => {},
9 9
     "won't-fetch" => {},
10  
-    "won't-build" => { :state<fetched> },
  10
+    "won't-build" => {},
11 11
     # RAKUDO: Need quotes around keys starting with 'has-' [perl #75694]
12 12
     'has-deps'   => { :state<fetched>, :deps<A B> },
13 13
     A            => { :state<fetched> },
14 14
     B            => { :state<fetched>, :deps<C D> },
15 15
     C            => {},
16  
-    D            => { :state<fetched> },
  16
+    D            => { :state<built> },
17 17
     circ-deps    => { :state<fetched>, :deps<E> },
18 18
     E            => { :state<fetched>, :deps<circ-deps> },
19  
-    dirdep-fails => { :state<fetched>, :deps<will-fail> },
  19
+    dirdep-fails => { :state<fetched>, :deps<won't-build> }, #'
20 20
     indir-fails  => { :state<fetched>, :deps<dirdep-fails> },
21 21
 ;
22 22
 
23 23
 my @actions;
24 24
 
25 25
 class Mock::Fetcher does App::Pls::Builder {
  26
+    method fetch($project --> Result) {
  27
+        push @actions, "fetch[$project]";
  28
+        $project eq "won't-fetch" ?? failure !! success;
  29
+    }
26 30
 }
27 31
 
28 32
 class Mock::Builder does App::Pls::Builder {
  33
+    method build($project --> Result) {
  34
+        push @actions, "build[$project]";
  35
+        $project eq "won't-build" ?? failure !! success;
  36
+    }
29 37
 }
30 38
 
31 39
 my $core = App::Pls::Core.new(
@@ -46,7 +54,7 @@ given $core {
46 54
     @actions = ();
47 55
     is .state-of('unfetched'), 'gone', "State before: 'gone'";
48 56
     is .build(<unfetched>), success, "Building unfetched project succeeded";
49  
-    is ~@actions, 'fetch[unfeched] build[unfetched]',
  57
+    is ~@actions, 'fetch[unfetched] build[unfetched]',
50 58
         "Fetched the project before building it";
51 59
     is .state-of('unfetched'), 'built', "State after of unfetched: 'built'";
52 60
 
@@ -60,14 +68,14 @@ given $core {
60 68
     # [T] Build a project; a build error occurs: Fail.
61 69
     @actions = ();
62 70
     is .build(<won't-build>), failure, "Won't build if build fails"; # "
63  
-    is ~@actions, "fetch[won't-build] build[won't build]", "Tried building";
64  
-    is .state-of("won't-build"), 'gone',
65  
-        "State after of won't-build: unchanged";
  71
+    is ~@actions, "fetch[won't-build] build[won't-build]", "Tried building";
  72
+    is .state-of("won't-build"), 'fetched',
  73
+        "State after of won't-build: 'fetched'";
66 74
 
67 75
     # [T] Build a project with dependencies: Build dependencies first.
68 76
     @actions = ();
69  
-    is .build(<has-deps>), 'success', "Building project with deps succeeds";
70  
-    is ~@actions, "fetch[C] build[A] build[C] build[D] build[has-deps]",
  77
+    is .build(<has-deps>), success, "Building project with deps succeeds";
  78
+    is ~@actions, "fetch[C] build[A] build[C] build[B] build[has-deps]",
71 79
         "Fetch before build, build with postorder traversal";
72 80
     is .state-of('has-deps'), 'built', "State after of has-deps: built";
73 81
     for <A B C D> -> $dep {
@@ -79,14 +87,14 @@ given $core {
79 87
     is .build(<circ-deps>), failure, "Building project with circ deps fails";
80 88
     is ~@actions, "", "Didn't even try to build anything";
81 89
     is .state-of('circ-deps'), 'fetched', "State after of circ-deps: unchanged";
82  
-    is .state-of('E'), 'fetched';
  90
+    is .state-of('E'), 'fetched', "State after of E: unchanged";
83 91
 
84 92
     # [T] Build a project whose direct dependency fails: Fail.
85 93
     is .build(<dirdep-fails>), failure, "Fail when direct dep fails to build";
86 94
     is .state-of('dirdep-fails'), 'fetched',
87 95
         "State after of dirdep-fails: unchanged";
88  
-    is .state-of('will-fail'), 'fetched',
89  
-        "State after of will-fail: unchanged";
  96
+    is .state-of("won't-build"), 'fetched',
  97
+        "State after of won't-build: unchanged";
90 98
 
91 99
     # [T] Build a project whose indirect dependency fails: Fail.
92 100
     is .build(<indir-fails>), failure, "Fail when indirect dep fails to build";
@@ -94,6 +102,6 @@ given $core {
94 102
         "State after of indir-fails: unchanged";
95 103
     is .state-of('dirdep-fails'), 'fetched',
96 104
         "State after of dirdep-fails: unchanged";
97  
-    is .state-of('will-fail'), 'fetched',
98  
-        "State after of will-fail: unchanged";
  105
+    is .state-of("won't-build"), 'fetched',
  106
+        "State after of won't-build: unchanged";
99 107
 }

0 notes on commit d952250

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