Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[App::Pls] implemented 'build'

All t/subcommands/build.t tests now pass.
  • Loading branch information...
commit d952250d9a34d966426cb870a53812629b111885 1 parent 44c586b
@masak authored
Showing with 62 additions and 18 deletions.
  1. +40 −4 lib/App/Pls.pm
  2. +22 −14 t/subcommands/build.t
View
44 lib/App/Pls.pm
@@ -1,14 +1,15 @@
use v6;
-subset State of Str where {
+subset State of Str where
'gone' | 'fetched' | 'built' | 'tested' | 'installed'
-};
+;
enum Result <failure success forced-success>;
role App::Pls::ProjectsState {
method state-of($project --> State) { !!! }
method set-state-of($project, State $state) { !!! }
method deps-of($project) { !!! }
+ method reached-state($project, State $state --> Bool) { !!! }
}
class App::Pls::ProjectsState::Hash does App::Pls::ProjectsState {
@@ -35,6 +36,13 @@ class App::Pls::ProjectsState::Hash does App::Pls::ProjectsState {
}
die "No such project: $project";
}
+
+ method reached-state($project, $goal-state --> Bool) {
+ my $actual-state = self.state-of($project);
+ my @states = <gone fetched built tested installed>;
+ my %state-levels = invert @states;
+ return %state-levels{$actual-state} >= %state-levels{$goal-state};
+ }
}
role App::Pls::Fetcher {
@@ -42,6 +50,7 @@ role App::Pls::Fetcher {
}
role App::Pls::Builder {
+ method build($project) { !!! }
}
role App::Pls::Tester {
@@ -76,7 +85,10 @@ class App::Pls::Core {
return failure
if self!fetch-helper($dep) == failure;
}
- if $!fetcher.fetch($project) == success {
+ if $!projects.reached-state($project, 'fetched') {
+ return success;
+ }
+ elsif $!fetcher.fetch($project) == success {
$!projects.set-state-of($project, 'fetched');
return success;
}
@@ -86,7 +98,31 @@ class App::Pls::Core {
}
method build(*@projects) {
- return;
+ for @projects -> $project {
+ my %*seen-projects;
+ return failure
+ if self!fetch-helper($project) == failure;
+ return failure
+ if self!build-helper($project) == failure;
+ }
+ return success;
+ }
+
+ method !build-helper($project --> Result) {
+ for $!projects.deps-of($project) -> $dep {
+ return failure
+ if self!build-helper($dep) == failure;
+ }
+ if $!projects.reached-state($project, 'built') {
+ return success;
+ }
+ elsif $!builder.build($project) == success {
+ $!projects.set-state-of($project, 'built');
+ return success;
+ }
+ else {
+ return failure;
+ }
}
method test(*@projects, Bool :$ignore-deps) {
View
36 t/subcommands/build.t
@@ -7,25 +7,33 @@ my %projects =
fetched => { :state<fetched> },
unfetched => {},
"won't-fetch" => {},
- "won't-build" => { :state<fetched> },
+ "won't-build" => {},
# RAKUDO: Need quotes around keys starting with 'has-' [perl #75694]
'has-deps' => { :state<fetched>, :deps<A B> },
A => { :state<fetched> },
B => { :state<fetched>, :deps<C D> },
C => {},
- D => { :state<fetched> },
+ D => { :state<built> },
circ-deps => { :state<fetched>, :deps<E> },
E => { :state<fetched>, :deps<circ-deps> },
- dirdep-fails => { :state<fetched>, :deps<will-fail> },
+ dirdep-fails => { :state<fetched>, :deps<won't-build> }, #'
indir-fails => { :state<fetched>, :deps<dirdep-fails> },
;
my @actions;
class Mock::Fetcher does App::Pls::Builder {
+ method fetch($project --> Result) {
+ push @actions, "fetch[$project]";
+ $project eq "won't-fetch" ?? failure !! success;
+ }
}
class Mock::Builder does App::Pls::Builder {
+ method build($project --> Result) {
+ push @actions, "build[$project]";
+ $project eq "won't-build" ?? failure !! success;
+ }
}
my $core = App::Pls::Core.new(
@@ -46,7 +54,7 @@ given $core {
@actions = ();
is .state-of('unfetched'), 'gone', "State before: 'gone'";
is .build(<unfetched>), success, "Building unfetched project succeeded";
- is ~@actions, 'fetch[unfeched] build[unfetched]',
+ is ~@actions, 'fetch[unfetched] build[unfetched]',
"Fetched the project before building it";
is .state-of('unfetched'), 'built', "State after of unfetched: 'built'";
@@ -60,14 +68,14 @@ given $core {
# [T] Build a project; a build error occurs: Fail.
@actions = ();
is .build(<won't-build>), failure, "Won't build if build fails"; # "
- is ~@actions, "fetch[won't-build] build[won't build]", "Tried building";
- is .state-of("won't-build"), 'gone',
- "State after of won't-build: unchanged";
+ is ~@actions, "fetch[won't-build] build[won't-build]", "Tried building";
+ is .state-of("won't-build"), 'fetched',
+ "State after of won't-build: 'fetched'";
# [T] Build a project with dependencies: Build dependencies first.
@actions = ();
- is .build(<has-deps>), 'success', "Building project with deps succeeds";
- is ~@actions, "fetch[C] build[A] build[C] build[D] build[has-deps]",
+ is .build(<has-deps>), success, "Building project with deps succeeds";
+ is ~@actions, "fetch[C] build[A] build[C] build[B] build[has-deps]",
"Fetch before build, build with postorder traversal";
is .state-of('has-deps'), 'built', "State after of has-deps: built";
for <A B C D> -> $dep {
@@ -79,14 +87,14 @@ given $core {
is .build(<circ-deps>), failure, "Building project with circ deps fails";
is ~@actions, "", "Didn't even try to build anything";
is .state-of('circ-deps'), 'fetched', "State after of circ-deps: unchanged";
- is .state-of('E'), 'fetched';
+ is .state-of('E'), 'fetched', "State after of E: unchanged";
# [T] Build a project whose direct dependency fails: Fail.
is .build(<dirdep-fails>), failure, "Fail when direct dep fails to build";
is .state-of('dirdep-fails'), 'fetched',
"State after of dirdep-fails: unchanged";
- is .state-of('will-fail'), 'fetched',
- "State after of will-fail: unchanged";
+ is .state-of("won't-build"), 'fetched',
+ "State after of won't-build: unchanged";
# [T] Build a project whose indirect dependency fails: Fail.
is .build(<indir-fails>), failure, "Fail when indirect dep fails to build";
@@ -94,6 +102,6 @@ given $core {
"State after of indir-fails: unchanged";
is .state-of('dirdep-fails'), 'fetched',
"State after of dirdep-fails: unchanged";
- is .state-of('will-fail'), 'fetched',
- "State after of will-fail: unchanged";
+ is .state-of("won't-build"), 'fetched',
+ "State after of won't-build: unchanged";
}
Please sign in to comment.
Something went wrong with that request. Please try again.